CODEWITHSUNDEEP
excelvbams-word
jwgoh
jwgoh

Reputation: 13

adding text, table and page number to footer in excel vba

I have been attempting to create a macro for header and footer. No issue with header, i can create it. The issue lies in the footer where i have to create a 2x1 table (the dimension as per in the code) together with 2 lines of text and page number (in the format page 1 of xx).

I am stuck because when i run the code, either the table or the text pops up. How can i modify the code so that I can have both the table and the text and the page number.

Thanks!

Sub CreateWord()

Dim objWord As Object
Dim objdoc As Object
Dim objrange As Word.Range
Dim myTable As Table
Dim i As Long

Set objWord = CreateObject("Word.Application")
objWord.Visible = True
Set objdoc = objWord.Documents.Add()
objdoc.PageSetup.OddAndEvenPagesHeaderFooter = False


For i = 1 To objdoc.Sections.Count
   With objdoc.Sections(i)

       Set objrange = .Headers(WdHeaderFooterIndex.wdHeaderFooterPrimary).Range
       objrange = "PRIVATE AND CONFIDENTIAL"
       objrange.Font.Name = "Arial"
       objrange.Font.Size = 11
       objrange.Font.Bold = wdToggle
       objrange.ParagraphFormat.Alignment = wdAlignParagraphCenter
       Set objrange = Nothing

       Set objrange = .Footers(wdHeaderFooterPrimary).Range
       objrange = "text1" & vbNewLine & "text2" & vbNewLine & " " & vbNewLine & " "
       .Footers(wdHeaderFooterPrimary).PageNumbers.Add FirstPage:=True
       objrange.Font.Name = "Arial"
       objrange.Font.Size = 9
       objrange.Font.Bold = wdToggle
       objrange.ParagraphFormat.Alignment = wdAlignParagraphLeft
       Set objrange = Nothing

       .Footers(wdHeaderFooterPrimary).PageNumbers.Add FirstPage:=True

   End With

     With objdoc
         Set myTable = .Tables.Add(.Sections(1).Footers(wdHeaderFooterPrimary).Range, 2, 1)
     End With

         With myTable

             .Cell(1, 1).Range.Text = "Employee"
             .Cell(2, 1).Range.Text = " " & vbNewLine & " "
             .Rows.SetLeftIndent LeftIndent:=395, RulerStyle:=wdAdjustFirstColumn
             .Borders.InsideLineStyle = wdLineStyleSingle
             .Borders.OutsideLineStyle = wdLineStyleSingle
         End With
Next

End Sub

Upvotes: 1

Views: 1626

Answers (1)

Variatus
Variatus

Reputation: 14383

Word is more complicated than Excel. You got stuck at the presumption that the Footer.Range would be identical both with its text and with its paragraphs. In fact, the Footer includes several paragraphs with individual ranges and each one with its own Text which is indeed the default property but not identical, much like a cell's value isn't identical to a cell in Excel. I have tested the code below in Word. I think it will run in Excel after re-defining the objWord object. Good luck!

Sub CreateWord()
    ' 04 Jan 2019

    Dim objWord As Object
    Dim objDoc As Object
    Dim objRange As Word.Range
    Dim myTable As Table
    Dim i As Long
    Dim f As Long

'    Set objWord = CreateObject("Word.Application")
    Set objWord = Application
    objWord.Visible = True
    Set objDoc = objWord.Documents.Add()
    objDoc.PageSetup.OddAndEvenPagesHeaderFooter = False

    For i = 1 To objDoc.Sections.Count
        With objDoc.Sections(i)
            Set objRange = .Headers(WdHeaderFooterIndex.wdHeaderFooterPrimary).Range
            objRange = "PRIVATE AND CONFIDENTIAL"
            objRange.Font.Name = "Arial"
            objRange.Font.Size = 11
            objRange.Font.Bold = vbTrue              'wdToggle
            objRange.ParagraphFormat.Alignment = wdAlignParagraphCenter
            Set objRange = Nothing

            ' you are setting only one header
            ' the code below sets all footers
            For f = wdHeaderFooterPrimary To wdHeaderFooterFirstPage
                Set objRange = .Footers(f).Range
                With objRange
                    .ParagraphFormat.Alignment = wdAlignParagraphLeft
                    With .Font
                        .Name = "Arial"
                        .Size = 9
                        .Bold = vbTrue                  'wdToggle
                    End With
                    .Text = "text1" & Chr(11) & _
                            "text2" & Chr(9) & "Page "
                    .Collapse wdCollapseEnd
                    .Fields.Add Range:=objRange, _
                                Type:=wdFieldEmpty, _
                                Text:="PAGE  \* Arabic ", _
                                PreserveFormatting:=True
                End With

                Set objRange = .Footers(f).Range.Paragraphs(1).Range
                With objRange
                    .Paragraphs.Add
                    .Collapse wdCollapseEnd
                    Set myTable = .Tables.Add(objRange, 2, 1)
                End With

                ' vbNewLine = Chr(13) = hard return = new paragraph
                ' Chr(11) = soft return = new line
                With myTable
                    .Cell(1, 1).Range.Text = "Employee"
                    .Cell(2, 1).Range.Text = " " & Chr(11) & " "
                    ' you may want to set the left margin of the paragraph
                    ' rather than indenting the table:-
                    .Rows.SetLeftIndent LeftIndent:=39.5, RulerStyle:=wdAdjustFirstColumn
                    .Borders.InsideLineStyle = wdLineStyleSingle
                    .Borders.OutsideLineStyle = wdLineStyleSingle
                End With
            Next f
        End With
    Next i
End Sub

Upvotes: 1

Related Questions