MS Word Macro Picture Help

Posted on 2009-05-19
Last Modified: 2012-05-07

I need to play two graphic files at the top of my page.  This is to create a letter head using a macro.  The transcription department transcribes medical records, and we want to stop printing on letterhead.  I would like the graphics to be part of the Header, since I cut and past the body frequently for other purposes.

I have a start, but I cannot get the two images to be far left and far right respectively.  I want the LOGO to be far left (Farther than the margin, and the second graphic LH2.bmp to be far right.  This is the address portion saved as a graphic.

The macro then puts some text at the bottom.  

I just need a little help.  High points for speed.


Sub LH1()


' LH1 Macro

' Macro recorded 5/19/2009 by overhotl


    If ActiveWindow.View.SplitSpecial <> wdPaneNone Then


    End If

    If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _

        ActivePane.View.Type = wdOutlineView Then

        ActiveWindow.ActivePane.View.Type = wdPrintView

    End If

    ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader

    Selection.InlineShapes.AddPicture FileName:= _

        "C:\Documents and Settings\overhotl\My Documents\LH1LOGO.PNG", LinkToFile _

        :=False, SaveWithDocument:=True

        Selection.PageSetup.RightMargin = InchesToPoints(0.25)

    With Selection.ParagraphFormat

        .LeftIndent = InchesToPoints(-1.5)

        .SpaceBeforeAuto = False

        .SpaceAfterAuto = False

    End With


    Selection.InlineShapes.AddPicture FileName:= _

        "C:\Documents and Settings\overhotl\My Documents\LH2.BMP", LinkToFile _

        :=False, SaveWithDocument:=True

        Selection.PageSetup.RightMargin = InchesToPoints(0.25)

    With Selection.ParagraphFormat

        .LeftIndent = InchesToPoints(5.5)

        .SpaceBeforeAuto = False

        .SpaceAfterAuto = False

    End With

    'Selection.TypeText Text:="                    "

    If Selection.HeaderFooter.IsHeader = True Then

        ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter


        ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader

    End If

    Selection.TypeText Text:="Work Well Clinic" & vbTab & "Therapy Plus" & _

        vbTab & "Hearing Conservation"


    Selection.TypeText Text:="(319) 369-8153" & vbTab & "(3190 369-8107" & _

        vbTab & "(319) 369-7569"

    Selection.MoveUp Unit:=wdLine, Count:=2, Extend:=wdExtend

    Selection.Font.Name = "Monotype Corsiva"

    Selection.Font.Size = 14

    ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument

End Sub

Open in new window

Question by:toverholt
1 Comment
LVL 76

Accepted Solution

GrahamSkan earned 500 total points
ID: 24427194
You need to insert  the pictures as Shapes if you want the flexibility to locate them in any position.
Sub LH2()

    Dim strPicture1 As String

    Dim strPicture2 As String

    Dim Doc As Document

    Dim hdr As HeaderFooter

    Dim ftr As HeaderFooter

    Dim sh1 As Shape

    Dim sh2 As Shape

    Dim hfix As WdHeaderFooterIndex


    strPicture1 = "C:\Documents and Settings\overhotl\My Documents\LH1LOGO.PNG"

    strPicture2 = "C:\Documents and Settings\overhotl\My Documents\LH2.BMP"

    Set Doc = ActiveDocument

    If Doc.Sections(1).PageSetup.DifferentFirstPageHeaderFooter Then

        hfix = wdHeaderFooterFirstPage


        hfix = wdHeaderFooterPrimary

    End If

    Set hdr = Doc.Sections(1).Headers(hfix)

    Set sh1 = Doc.Shapes.AddPicture(strPicture1, False, True, , , , , hdr.Range)

    sh1.RelativeHorizontalPosition = wdRelativeHorizontalPositionPage

    sh1.Left = 0

    Set sh2 = Doc.Shapes.AddPicture(strPicture1, False, True, , , , , hdr.Range)

    sh2.RelativeHorizontalPosition = wdRelativeHorizontalPositionPage

    sh2.Left = Doc.Sections(1).PageSetup.PageWidth - sh2.Width


    Set ftr = Doc.Sections(1).Footers(hfix)

    ftr.Range.Text = "Work Well Clinic" & vbTab & "Therapy Plus" & _

        vbTab & "Hearing Conservation" & vbCr & _

                "(319) 369-8153" & vbTab & "(3190 369-8107" & _

                vbTab & "(319) 369-7569"


    ftr.Range.Font.Name = "Monotype Corsiva"

    ftr.Range.Font.Size = 14

End Sub

Open in new window


Featured Post

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

This article describes how to use the Send to Mail Recipient command. The instructions apply generally to Office 2007 and later versions, but Microsoft® Word 2013 was used for the specific steps and figures.  What is Send to Mail Recipient? Send…
Using Word 2013, I was experiencing some incredible lag when typing.  Here's what worked for me....
In this video, we show how to convert an image-only PDF file into a PDF Searchable Image file, that is, a file with both the image (typically from scanning) and text, which is created in an automated fashion with Optical Character Recognition (OCR) …
This video walks the viewer through the process of creating Hyperlinks for the web and other documents. Select the "Insert" tab: Click "Hyperlink":  Type "http://" followed by a web address to reference a website or navigate to a document to ref…

863 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

22 Experts available now in Live!

Get 1:1 Help Now