PDA

View Full Version : Excel Macro to Insert Footer Text and Page #s in Word (x-post from Excel Help)



mstar
01-28-2015, 02:32 PM
Hi all,

I've got a macro I'm using that copies a number of Excel ranges and pastes them into a new Word document. When finished, the document should have three sections with page numbers (aligned right) throughout and a footer (aligned left) only in section 2. Here's what I've developed so far (sorry - it's likely not the cleanest code):

Section 1

With wrdApp.ActiveDocument.Sections(1)
.Footers(wdHeaderFooterPrimary).PageNumbers.Add wdAlignPageNumberRight
.Footers(wdHeaderFooterPrimary).PageNumbers.ShowFirstPageNumber = False
.Footers(wdHeaderFooterPrimary).PageNumbers.RestartNumberingAtSection = True
.Footers(wdHeaderFooterPrimary).PageNumbers.StartingNumber = 0
End With
Section 2


wrdApp.Selection.InsertBreak Type:=wdSectionBreakNextPage
With wrdApp.ActiveDocument.Sections(2)
.Footers(wdHeaderFooterPrimary).LinkToPrevious = False
.Footers(wdHeaderFooterPrimary).Range.InsertBefore "Note: * significant for p<.05; Cohen’s D effect size are: “-“ for <.2 “+” for .2 - .49 “++” for .5 - .79 “+++” for >.8"
.Footers(wdHeaderFooterPrimary).PageNumbers.Add wdAlignPageNumberRight
.Footers(wdHeaderFooterPrimary).PageNumbers.ShowFirstPageNumber = True
.Footers(wdHeaderFooterPrimary).PageNumbers.RestartNumberingAtSection = False
End With
Section 3


wrdApp.Selection.InsertBreak Type:=wdSectionBreakNextPage
With wrdApp.ActiveDocument.Sections(3)
.Footers(wdHeaderFooterPrimary).LinkToPrevious = False
.Footers(wdHeaderFooterPrimary).PageNumbers.Add wdAlignPageNumberRight
.Footers(wdHeaderFooterPrimary).PageNumbers.ShowFirstPageNumber = True
.Footers(wdHeaderFooterPrimary).PageNumbers.RestartNumberingAtSection = False
End With

With this code, the page numbers get inserted throughout the document (right justified) and they number correctly. The section 2 footer text is also added, but it is added right justified as well. I tried inserting the section 2 footer text in section 1 before the alignment code just to see if it would work, and it did... that leads me to believe it's a formatting issue. Once the page numbering format is set to be right aligned, it keeps it there.

Any thoughts on how I can fix this? If you need more information or add'l code from me, let me know. I'm still pretty new at this, and I appreciate any suggestions you might have.

gmayor
02-02-2015, 12:44 AM
The following will create a document from Excel, add two sections and format the footers as you indicated. The section 2 footer will probably take up more than one line, but the page number will be right aligned at the end. You can set the range to the required section to add the Excel data as shown at the end of the code.



Option Explicit
'Uses late binding to Word so a reference to Word object library is not required
Sub CreateDoc()
Dim wrdApp As Object
Dim oDoc As Object
Dim oSection As Object
Dim oFooter As Object
Dim oRng As Object
Dim i As Long
Dim lngRight As Long

On Error Resume Next
Set wrdApp = GetObject(, "Word.Application")
If Err Then
Set wrdApp = CreateObject("Word.Application")
End If
On Error GoTo 0

Set oDoc = wrdApp.Documents.Add
lngRight = oDoc.PageSetup.PageWidth _
- oDoc.PageSetup.LeftMargin _
- oDoc.PageSetup.RightMargin

For Each oSection In oDoc.Sections
Set oFooter = oSection.Footers(1)
oFooter.LinkToPrevious = False
oFooter.PageNumbers.RestartNumberingAtSection = False
Set oRng = oFooter.Range
oRng.ParagraphFormat.TabStops.ClearAll
oRng.ParagraphFormat.TabStops.Add _
Position:=lngRight, _
Alignment:=2, _
Leader:=0
oRng.Text = vbTab
oRng.Collapse 0
oRng.Fields.Add oRng, 33 'Insert a Page number field
Next oSection

Set oRng = oDoc.Sections(2).Footers(1).Range 'Add the footer text to section 2
oRng.Collapse 1 'Collapse to the start of the range
oRng.Text = "Note: * significant for p<.05; Cohen’s D effect size are: “-“ for <.2 “+” for .2 - .49 “++” for .5 - .79 “+++” for >.8"
Set oRng = oDoc.Sections(1).Range 'The body of section 1 for your Excel data - repeat for Sections 2 and 3 as required
'Do stuff with oRng
lbl_Exit:
Set wrdApp = Nothing
Set oDoc = Nothing
Set oSection = Nothing
Set oFooter = Nothing
Set oRng = Nothing
Exit Sub
End Sub