Search code examples
excelvbams-wordlate-binding

How to insert a picture in wordDocument.header using late binding from excel vba


from EXCEL VBA I want to insert a picture in a word document I can open a word document but I get a Object required error when activating a header in word. How to set the header as a activated object and insert a picture on the right top side ?


Sub insertPicInWordHeader()
        Dim wdApp As Object
        Dim wdDoc As Object
        Dim rng As Range
        'Turn off error handling since if the Application is not found we'll get an error
        'Use Late Binding and the GetObject method to find any open instances of Word
        On Error Resume Next
        Set wdApp = GetObject(, "Word.Application")
        wdApp.Visible = True

        On Error GoTo 0

        'Check to see if we found an instance.  If not you can create one if you desire
        If wdApp Is Nothing Then
            MsgBox "No open files of Word found"
            Set wdApp = Nothing
            Set wdApp = CreateObject("Word.Application")
            wdApp.Visible = True
        End If

        myFile = "c:\users\bsa\Documents\test.docx"
        Set wdDoc = wdApp.Documents.Open(myFile)
        wdDoc.Activate

        'Check if there are documents in the found instance of Word
        If wdApp.Documents.count > 0 Then



        For Each oSec In wdDoc.Sections
     'This next line gives Error 424 "Object required "
        For Each rng In oSec.Headers(Word.WdHeaderFooterIndex.wdHeaderFooterPrimary).Range
            With rng
                .Tables.Add Range:=rng, NumRows:=1, NumColumns:=1, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:=wdAutoFitWindow
                With .Tables(1)
                    .Borders.InsideLineStyle = wdLineStyleNone
                    .Borders.OutsideLineStyle = wdLineStyleNone
                    .rows.SetLeftIndent LeftIndent:=-37, RulerStyle:=wdAdjustNone
                    .Cell(1, 1).Range.InlineShapes.AddPicture Filename:="c:\users\bsa\Documents\test.png", LinkToFile:=False, SaveWithDocument:=True
                End With
            End With
    Next
    Next
        End If

        'Clean up the Object when Finished
        Set wdApp = Nothing
    End Sub

Solution

  • Thanks @cindymeister I solved it in this manner andd post it for other users

    Dim shp As Object
     For Each oSec In wdDoc.sections
             With oSec.Headers(1)
              shp = .InlineShapes.AddPicture(myPath & company & ".png")
               'delete other things in header
               .Range.Delete
               .Range.InlineShapes.AddPicture Filename:=myPath & company & ".png", LinkToFile:=False, SaveWithDocument:=True
               .Range.shp.Height = m_oWord.InchesToPoints(0.72)
               .Range.Paragraphs.Alignment = 2 ' 1 center 2 right
             End With
      Next