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

mrwad

New Member
Joined
Oct 16, 2018
Messages
49
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:

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
 

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).
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...
 
Last edited:
Upvote 0

Forum statistics

Threads
1,223,886
Messages
6,175,198
Members
452,616
Latest member
intern444

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top