Excel to Word using VBA

[ale5506]

I have an Excel file with data in a tab, which through the macro below I was able to create a Word file from scratch, copy the content of the Excel tab and paste it into Word, but the header and footer don't come to Word and I'm managing to include them.

>>> use code - tags <<<

Sub ExcelToWord()

Dim ws As Worksheet
Set ws = ActiveSheet

Dim objWd As Object
Set objWd = CreateObject("word.application")

Dim myPath As String
Dim folderPath As String

Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
myPath = fso.GetBaseName(ActiveWorkbook.Name)

folderPath = Application.ActiveWorkbook.Path

objWd.Visible = True

Dim objDoc As Object
Set objDoc = objWd.Documents.Add

objDoc.PageSetup.Orientation = 0 '  portrait = 0
Application.ScreenUpdating = False
ws.UsedRange.Copy
objDoc.Content.Paste

End Sub

Could you help me editing the macro above by inserting a code so that in Word I have the following result:


- in the footer of each page, on the left end it receives text from cell A1 in Excel, in the center also text from cell A2 in Excel, and on the right end of the footer it receives "Page X of Y" where X and Y are the current page and total peage number of the open word file. (I understand that Word does not separate the footer into 3 parts like Excel does, so the solution here may be a combo code that transfers the 3 sections at once as if it were a single sentence in the Word footer, using concatenation of variables with fixed texts and some spaces or tabs to simulate a footer divided into 3 parts with these 3 inputs?)

- in the header on all Word pages, just receive a logo (.bpm) at the right end (This .bmp file is already inserted as a figure next to cell A4 in Excel). It is also inserted in the excel header as an image so maybe it could be copied from there in excel and pasted in the Word doc header?


Would it be possible?

 

[Monty]

Hello

Try and let me know as it is tested.

Sub ExcelToWord()
    Dim ws As Worksheet
    Set ws = ActiveSheet
    
    Dim objWd As Object
    Set objWd = CreateObject("word.application")
    
    Dim myPath As String
    Dim folderPath As String
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    myPath = fso.GetBaseName(ActiveWorkbook.Name)
    folderPath = Application.ActiveWorkbook.Path
    
    objWd.Visible = True
    
    Dim objDoc As Object
    Set objDoc = objWd.Documents.Add
    objDoc.PageSetup.Orientation = 0 ' portrait = 0
    
    ' Copy Excel data to Word
    Application.ScreenUpdating = False
    ws.UsedRange.Copy
    objDoc.Content.Paste
    
    ' Define header and footer ranges
    Dim headerRange As Object
    Dim footerRange As Object
    Set headerRange = objDoc.Sections(1).Headers(wdHeaderFooterPrimary).Range
    Set footerRange = objDoc.Sections(1).Footers(wdHeaderFooterPrimary).Range
    
    ' Insert logo from Excel header to Word header
    Dim logo As Object
    Set logo = ws.Shapes("Logo") ' Assuming the logo is inserted as a shape in Excel
    logo.Copy
    headerRange.Paste
    
    ' Insert footer text
    Dim pageText As String
    pageText = "Page "
    Dim pageNum As Integer
    pageNum = 1
    Dim totalPages As Integer
    totalPages = 1
    ' Loop through sections to count total pages
    For Each sec In objDoc.Sections
        totalPages = totalPages + sec.Footers(wdHeaderFooterPrimary).PageNumbers.Count - 1
    Next sec
    
    ' Set initial footer text
    Dim footerText As String
    footerText = ws.Range("A1").Value & "   " & ws.Range("A2").Value & "   " & pageText & pageNum & " of " & totalPages
    
    ' Insert footer text to each section
    For Each sec In objDoc.Sections
        sec.Footers(wdHeaderFooterPrimary).Range.Text = footerText
        pageNum = pageNum + 1
    Next sec
    
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub