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

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

There is a feature provided by MS Word that lets you create an Table of Contents for your Word document automatically. To use this feature for other documents there are two steps involved,   1.  Prepare your document for a table of contents (he…
This is written from a 'VBA for MS Word' perspective, but I am sure it applies to most other MS Office components where VBA is used.  One thing that really bugs me is slow code, ESPECIALLY when it's mine!  In programming there are so many ways to…
Office 365 is currently available in five editions. Three of them are for business use: Office 365 Business Essentials, Office 365 Business, and Office 365 Business Premium. Two of them are for home/personal use: Office 365 Home and Office 365 Perso…
This Experts Exchange video Micro Tutorial shows how to tell Microsoft Office that a word is NOT spelled correctly. Microsoft Office has a built-in, main dictionary that is shared by Office apps, including Excel, Outlook, PowerPoint, and Word. When …

747 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

11 Experts available now in Live!

Get 1:1 Help Now