How to copy text from an excel file into a newly generated Word document's header?

[Devagorgon]

I have to write a macro in Excel VBA to convert a given Excel Document into a word file.
So far I have managed most of the normal copying starting like this

Dim oConvWB As Workbook
Set oConvWB = Workbooks.Open(TextBox_ExcelPath.Text)
Dim AppWord As Object
Set AppWord = CreateObject("Word.Application")
Set AppWdDoc = AppWord.Documents.Add
AppWord.Visible = True

I copy the normal content via

oConvWB.Sheets("S1 Deckblat").Select
oConvWB.Sheets("S1 Deckblat").Range(Cells(18, 1), Cells(43, 8)).Copy
AppWord.Selection.PasteExcelTable _
LinkedToExcel:=False, _
WordFormatting:=False, _
RTF:=True

The Problem ist, that I have some selected content, I need to write into Header and Footnotes (different for first and later pages) and I cannot find any working (paste- or accessing-) commands.
Using commands like
Dim HdrRange As Range
Set HdrRange = AppWdDoc.Sections.Item(1).Headers(wdHeaderFooterPrimary).Range
will crash at the Set command

Even just manipulating the Header Text via
AppWord.Sections(1).Headers(wdHeaderFooterPrimary).Range.Text = "Text"
fails with an error.

If someone could tell me, how I can insert text (or even better, how I can paste my selected Cells from Excel), I'd be grateful.

 

[Devagorgon]

Edit Issue 1: Cleared via use of
AppWdDoc.Sections(1).Headers(1).Range.Tables(1).Cell(3, 4).Range.Text

 

[Macropod]

I've looked up, how to insert a PageNumber in Excel. It seems you have to either activate Footnotes directly in Exel (then you cannot do any complicated Table Stuff in the Header, so I am copying Text from Excel Body to Word Header and Footer)

That makes no sense at all to me; the only reason you'd work with a header or footer in Word is because you need the content to appear in that area (e.g. because it should appear on multiple pages and/or in multiple Sections).

Issue 1: How to write into my inserted Table? I will try some more, but things like
AppWdDoc.Sections(1).Headers(1).Range(Cells(1, 1), Cells(1, 1)).Text = "sdgsdgdhbs"

Instead of just throwing random bits of code at the problem, you should spend a little time in Word's own VBE finding out what methods, properties etc. are applicable:
AppWdDoc.Sections(1).Headers(1).Range.Tables(1).Cell(1, 1).Range.Text = "sdgsdgdhbs"

Issue 2: How to insert the Page number via code? I've read, that you can enter it manually by pressing Control+F, then inserting Page into the resulting brackets and then pressing Alt+F9, but for that I need to emulate the button presses, thus I'm not sure this works.

What page # do you need - the Excel one, or the Word one. Obviously, the code for Word is entirely different from what it would be for Excel. If you want an idea of what the code for Word would be like, use Word's macro recorder to insert a PAGE field into a document.

 

[Devagorgon]

I have to Re-Build a given Word template using Excel. The header has some styled tables includes the page numbers. Since the Word document is the final result, it should define the pages.

I have a little freedom in defining the Excel-Dokument, so I aim to make something, where the user can insert his predefined values, which then will be calculated and spread to the other worksheets as intended, which can be converted into a word document using the Excel makro.

Sadly I have next to none experience in Excel and Word VBA (its my first macro there) and just stumble through the built-in VBA help. (As you may have realized by now.)

If I use the Word Makro-Recorder I get the following Line
Application.Templates( _
"C:\Users\XXX\AppData\Roaming\Microsoft\Document Building Blocks\1031\16\Built-In Building Blocks.dotx" _
).BuildingBlockEntries("Fett formatierte Zahlen").Insert Where:=Selection _
.Range, RichText:=True
This depends on System-Language, Username and Office Version, so I don't want to use it.

If I use it, with the Control + F9 way I posted above I get
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, _
PreserveFormatting:=False
Selection.TypeText Text:="Page"
ActiveWindow.View.ShowFieldCodes = Not ActiveWindow.View.ShowFieldCodes
ActiveWindow.View.ShowFieldCodes = Not ActiveWindow.View.ShowFieldCodes
Which will produce various Errors in Excel.

I also fount a bit of code like
cellRange.InsertAfter "{ FILENAME \p }"
TextToFields cellRange
which ought to to the same, but TextToFields produces an error.

When I am finally finished with the makro, I intent to post it..

 

[Devagorgon]

Forget the FILENAME \p part. It was
.InsertAfter "{ PAGE }"
(didn't work nonetheless, because of the following command)

At the moment, I know how to Add Text to a cell.
It's either
AppWdDoc.Sections(1).Headers(1).Range.Tables(1).Cell(3, 4).Range.Text = "Text"
or
AppWdDoc.Sections(1).Headers(1).Range.Tables(1).Cell(3, 4).Range.insertAfter "Text"

Also, I know how to add the Pagenumber to the Current Position of the Document. It's
AppWdDoc.Sections(1).Headers(1).PageNumbers.Add

The Problem is, how I can merge these two and add the PageNumber into the cell, meaning how I can access the Cell Object and insert the PageNumber Object.

 

[Devagorgon]

I think I got it. You yourself posted it here:
https://forums.windowssecrets.com/s...How-to-make-a-Macro-for-Page-number-in-footer

In my case I have to use
AppWdDoc.Fields.Add Range:=AppWdDoc.Sections(1).Headers(1).Range.Tables(1).Cell(3, 4).Range.Characters.First, Type:=-1, Text:="PAGE", PreserveFormatting:=False

 

[Devagorgon]

I'm finished. The Rest is finetuning.

Thanks Macropod, I couldn't have done it without your tips.

As promised, here's the code:


Private Sub Button_Convert_Click()

'Prüfe Datei auf Existenz
If TextBox_ExcelPath.Text = "" Then
MsgBox "Keine Datei definiert. Abbruch"
Exit Sub
End If
If Dir(TextBox_ExcelPath.Text) = "" Then
MsgBox "Datei " & TextBox_ExcelPath.Text & " nicht vorhanden. Abbruch"
Exit Sub
End If

Dim oConvWB As Workbook

Set oConvWB = Workbooks.Open(TextBox_ExcelPath.Text)

Const wdPageBreak As Long = 7

Const wdLineBreak As Long = 6

'Lade Datei und wandle um

Dim AppWord As Object

Set AppWord = CreateObject("Word.Application")

Dim AppWdDoc As Object

Set AppWdDoc = AppWord.Documents.Add

AppWord.Visible = True

oConvWB.Sheets("Header").Select

AppWdDoc.PageSetup.DifferentFirstPageHeaderFooter = False

oConvWB.Sheets("Header").Range(Cells(23, 1), Cells(25, 6)).Copy

AppWdDoc.Sections(1).Headers(1).Range.PasteExcelTable LinkedToExcel:=False, WordFormatting:=False, RTF:=False

AppWdDoc.Fields.Add Range:=AppWdDoc.Sections(1).Headers(1).Range.Tables(1).Cell(3, 4).Range.Characters.First, Type:=-1, Text:="PAGE", PreserveFormatting:=False

oConvWB.Sheets("Header").Range(Cells(29, 1), Cells(31, 1)).Copy

AppWdDoc.Sections(1).Headers(1).Range.PasteSpecial Link:=False, Placement:=1, DisplayAsIcon:=False, DataType:=9

oConvWB.Sheets("Header").Range(Cells(27, 1), Cells(27, 6)).Copy

AppWdDoc.Sections(1).Footers(1).Range.Paste

AppWdDoc.PageSetup.DifferentFirstPageHeaderFooter = True

oConvWB.Sheets("Header").Range(Cells(2, 1), Cells(12, 6)).Copy

AppWdDoc.Sections(1).Headers(2).Range.PasteExcelTable LinkedToExcel:=False, WordFormatting:=False, RTF:=False

AppWdDoc.Fields.Add Range:=AppWdDoc.Sections(1).Headers(2).Range.Tables(1).Cell(3, 4).Range.Characters.First, Type:=-1, Text:="PAGE", PreserveFormatting:=False

oConvWB.Sheets("Header").Range(Cells(29, 1), Cells(31, 1)).Copy

AppWdDoc.Sections(1).Headers(2).Range.PasteSpecial Link:=False, Placement:=1, DisplayAsIcon:=False, DataType:=9

oConvWB.Sheets("Header").Range(Cells(29, 1), Cells(31, 1)).Copy

AppWdDoc.Sections(1).Headers(2).Range.PasteSpecial Link:=False, Placement:=1, DisplayAsIcon:=False, DataType:=9

oConvWB.Sheets("Header").Range(Cells(14, 1), Cells(21, 6)).Copy

AppWdDoc.Sections(1).Footers(2).Range.Paste

AppWdDoc.Characters.Last.Select

oConvWB.Sheets("S1").Select

oConvWB.Sheets("S1").Range(Cells(1, 1), Cells(21, 8)).Copy

AppWord.Selection.Paste

AppWdDoc.Characters.Last.Select

AppWord.Selection.InsertBreak wdPageBreak

AppWdDoc.Characters.Last.Select

oConvWB.Sheets("S2").Select

oConvWB.Sheets("S2").Range(Cells(1, 1), Cells(1, 1)).Copy

AppWord.Selection.PasteExcelTable _
LinkedToExcel:=False, _
WordFormatting:=False, _
RTF:=True

oConvWB.Sheets("S2").Range(Cells(3, 1), Cells(3, 8)).Copy

AppWord.Selection.Paste

oConvWB.Sheets("S2").Range(Cells(5, 1), Cells(38, 8)).Copy

AppWord.Selection.PasteExcelTable _
LinkedToExcel:=False, _
WordFormatting:=False, _
RTF:=True

AppWdDoc.Characters.Last.Select

AppWord.Selection.InsertBreak wdPageBreak

AppWdDoc.Characters.Last.Select

oConvWB.Sheets("S3").Select

oConvWB.Sheets("S3").Range(Cells(1, 1), Cells(14, 5)).Copy

AppWord.Selection.PasteExcelTable _
LinkedToExcel:=False, _
WordFormatting:=False, _
RTF:=True

AppWdDoc.Characters.Last.Select

AppWord.Selection.InsertBreak wdPageBreak

AppWdDoc.Characters.Last.Select

oConvWB.Sheets("S4").Select

oConvWB.Sheets("S4").Range(Cells(1, 1), Cells(38, 7)).Copy

AppWord.Selection.PasteExcelTable _
LinkedToExcel:=False, _
WordFormatting:=False, _
RTF:=True

AppWdDoc.Characters.Last.Select

AppWord.Selection.InsertBreak wdPageBreak

AppWdDoc.Characters.Last.Select

oConvWB.Sheets("S5").Select

oConvWB.Sheets("S5").Range(Cells(1, 1), Cells(30, 5)).Copy

AppWord.Selection.PasteExcelTable _
LinkedToExcel:=False, _
WordFormatting:=False, _
RTF:=True

AppWdDoc.Characters.Last.Select

AppWord.Selection.InsertBreak wdPageBreak

AppWdDoc.Characters.Last.Select

oConvWB.Sheets("S6").Select

oConvWB.Sheets("S6").Range(Cells(1, 1), Cells(34, 8)).Copy

AppWord.Selection.PasteExcelTable _
LinkedToExcel:=False, _
WordFormatting:=False, _
RTF:=True

AppWdDoc.Characters.Last.Select

AppWord.Selection.InsertBreak wdPageBreak

AppWdDoc.Characters.Last.Select

oConvWB.Sheets("S7").Select

oConvWB.Sheets("S7").Range(Cells(1, 1), Cells(11, 11)).Copy

AppWord.Selection.PasteExcelTable _
LinkedToExcel:=False, _
WordFormatting:=False, _
RTF:=True

AppWdDoc.Characters.Last.Select

AppWord.Selection.InsertBreak wdPageBreak

AppWdDoc.Characters.Last.Select

oConvWB.Sheets("S8").Select

oConvWB.Sheets("S8").Range(Cells(1, 1), Cells(53, 7)).Copy

AppWord.Selection.Paste

AppWdDoc.Characters.Last.Select

AppWord.Selection.InsertBreak wdPageBreak

AppWdDoc.Characters.Last.Select

oConvWB.Sheets("S9").Select

oConvWB.Sheets("S9").Range(Cells(1, 1), Cells(52, 7)).Copy

AppWord.Selection.PasteSpecial Placement:=0, DataType:=0

AppWdDoc.Characters.Last.Select

AppWord.Selection.InsertBreak wdPageBreak

AppWdDoc.Characters.Last.Select

oConvWB.Sheets("S10").Select

oConvWB.Sheets("S10").Range(Cells(1, 1), Cells(2, 2)).Copy

AppWord.Selection.PasteExcelTable _
LinkedToExcel:=False, _
WordFormatting:=False, _
RTF:=True

'Excel schließen
oConvWB.Saved = True
oConvWB.Close

'Speicherpfad prüfen und speichern
Set oFS = CreateObject("Scripting.FileSystemObject")

Dim SavePath As String

SavePath = oFS.GetParentFolderName(TextBox_ExcelPath.Text) & "" & oFS.GetBaseName(TextBox_ExcelPath.Text) & ".docx"

Set oFS = Nothing

AppWord.Visible = True

If Dir(SavePath) = "" Then
AppWord.ActiveDocument.SaveAs2 Filename:=SavePath
AppWord.Quit
Else
iResult = MsgBox("Zieldatei vorhanden. Überschreiben?", vbYesNo)
If iResult = 6 Then
AppWord.ActiveDocument.SaveAs2 Filename:=SavePath
AppWord.Quit
Else
AppWord.Visible = True
End If

End If
End Sub