Excel VBA copy range from Excel and paste it to Word header Text Box

[mrwad]

I have Excel Workbook from where I am running following code below. I have logo and page numbering already in Word document so I do not need to paste the whole range from Excel. I have two Text Boxes where data from spreadsheet should be inserted.

1. I need to copy `Worksheets("Other Data").Range("A58:A60")` and paste it to "Text Box 1" that I have in Word documents header. Three sentances on different rows. Text Box should be wrapped?

2. I need to copy `Worksheets("Other Data").Range("A68")` and paste it to "Text Box 2" that I have in Word documents header. One sentance.

3. AutoFitWindows doesn't work. There have to be something with variables but I can't figure what exactly is wrong. Tried different ways with no success.

Here is my code:

Sub excelToWord_click()
    
        Dim head As Excel.Range
        Dim foot As Excel.Range
        Dim WordTable As Word.Table
        Set wdApp = CreateObject("Word.Application")
        wdApp.Documents.Open FileName:=ThisWorkbook.Path & "\" & "MyDOC" & ".docx"
        wdApp.Visible = True
    
        Set head = ThisWorkbook.Worksheets("Other Data").Range("A58:A60")
    
        head.Copy
        
        '|| I need to paste copied cells to "Text Box 1" in my Word document ||'
        
        With wdApp.ActiveDocument.Sections(1)
            .Headers(wdHeaderFooterIndex.wdHeaderFooterPrimary).Range.Shapes("Text Box 1").Activate
            head.Paste
        End With
        
        '|| ---------------------------------------------------------------- ||'
        
            Set head2 = ThisWorkbook.Worksheets("Other Data").Range("A68")
    
        head2.Copy
        
        '|| I need to paste copied cells to "Text Box 2" in my Word document ||'
        
        With wdApp.ActiveDocument.Sections(1)
            .Headers(wdHeaderFooterIndex.wdHeaderFooterPrimary).Range.Shapes("Text Box 2").Activate
            head2.Paste
        End With
        
        '|| ---------------------------------------------------------------- ||'
        
            Set foot = ThisWorkbook.Worksheets("Other Data").Range("A62:H65")
        foot.Copy
        
        With wdApp.ActiveDocument.Sections(1)
        .Footers(wdHeaderFooterIndex.wdHeaderFooterPrimary).Range.Paste
        End With
        
        '|| Autofit table to page in Footer ||'
        
        WordTable.AutoFitBehavior (wdAutoFitWindow)
        
        '|| ---------------------------------------------------------------- ||'
        
        'restore Word
        If wdApp.ActiveWindow.View.SplitSpecial <> 0 Then
            wdApp.ActiveWindow.Panes(2).Close
        End If
        If wdApp.ActiveWindow.ActivePane.View.Type = 1 _
        Or wdApp.ActiveWindow.ActivePane.View.Type = 2 Then
            wdApp.ActiveWindow.ActivePane.View.Type = 3
        End If
        wdApp.WordBasic.AcceptAllChangesInDoc
        'wdApp.ActiveDocument.PrintOut, Copies:=1
        
        wdApp.ActiveDocument.ExportAsFixedFormat outputfilename:=ThisWorkbook.Path & "\" & Sheets("MAIN").Range("D14").Value & ", " & Sheets("MAIN").Range("D11").Value & "_" & "Document" & "_" & ".pdf", exportformat:=wdExportFormatPDF
        
        wdApp.ActiveDocument.SaveAs ThisWorkbook.Path & "\" & Worksheets("MAIN").Range("D14").Value & ", " & Worksheets("MAIN").Range("D11").Value & "_" & "Document" & "_" & ".docx"
            
            wdApp.Quit '<--| quit Word
        Set wdApp = Nothing '<--| release object variable
        'wdApp.ActiveWindow.Close savechanges:=False
    End Sub

 

[Macropod]

It's not apparent to me why you need a textbox for this; it would be a lot simpler if you didn't use one and simply used a bookmarked destination instead. That said, with a textbox, you could use:
wdApp.ActiveDocument.Sections(1).Headers(WdHeaderFooterIndex.wdHeaderFooterPrimary).Range.Shapes("Text Box 1").TextFrame.TextRange.Paste

You might also explore Word's other paste options...

 

[Macropod]

Cross-posted at: https://stackoverflow.com/questions...om-excel-and-paste-it-to-word-header-text-box

Please read Mr Excel's policy on Cross-Posting in rule 13: http://www.mrexcel.com/forum/board-announcements/99490-forum-rules.html