Consulting

Results 1 to 8 of 8

Thread: Modify a table in the header with VBA in Word

  1. #1
    VBAX Regular
    Joined
    Feb 2019
    Posts
    14
    Location

    Modify a table in the header with VBA in Word

    Hi all.

    I'm trying to programme a macro in word to change the header. In the header of the document I have a table and I need to change some things there (the background color, change the text of a cell...).

    For example I need to apply this comand to the header:

    Cell(1, 2).Shading.BackgroundPatternColor = 11382784


    My problem its that every macro I programme dont affect the header, just the document.

    I will need to change the header of the first page and the header of the rest of the pages.


    Thanks!

  2. #2
    You need to address the headers directly e.g. the following will address the headers and any tables they contain. It treats each section the same, but you can add code to address each section differently as required. I have only added code for the primary header. You can make your own choices for the other headers.

    Sub Macro1()
    Dim oSection As Section
    Dim oHeader As HeaderFooter
    Dim oTable As Table
        For Each oSection In ActiveDocument.Sections
            For Each oHeader In oSection.Headers
                If oHeader.Exists Then
                    Select Case oHeader.Index
                        Case Is = wdHeaderFooterPrimary
                            If oHeader.Range.Tables.Count > 0 Then
                                Set oTable = oHeader.Range.Tables(1)
                                oTable.Cell(1, 2).Shading.BackgroundPatternColor = 11382784
                            End If
                        Case Is = wdHeaderFooterFirstPage
                            If oHeader.Range.Tables.Count > 0 Then
                                Set oTable = oHeader.Range.Tables(1)
                                'do stuff with otable
                            End If
                        Case Is = wdHeaderFooterEvenPages
                            If oHeader.Range.Tables.Count > 0 Then
                                Set oTable = oHeader.Range.Tables(1)
                                'do stuff with otable
                            End If
                    End Select
                End If
            Next oHeader
        Next oSection
    lbl_Exit:
        Set oSection = Nothing
        Set oHeader = Nothing
        Set oTable = Nothing
        Exit Sub
    End Sub
    Graham Mayor - MS MVP (Word)
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  3. #3
    VBAX Regular
    Joined
    Feb 2019
    Posts
    14
    Location
    Quote Originally Posted by gmayor View Post
    You need to address the headers directly e.g. the following will address the headers and any tables they contain. It treats each section the same, but you can add code to address each section differently as required. I have only added code for the primary header. You can make your own choices for the other headers.

    Sub Macro1()
    Dim oSection As Section
    Dim oHeader As HeaderFooter
    Dim oTable As Table
        For Each oSection In ActiveDocument.Sections
            For Each oHeader In oSection.Headers
                If oHeader.Exists Then
                    Select Case oHeader.Index
                        Case Is = wdHeaderFooterPrimary
                            If oHeader.Range.Tables.Count > 0 Then
                                Set oTable = oHeader.Range.Tables(1)
                                oTable.Cell(1, 2).Shading.BackgroundPatternColor = 11382784
                            End If
                        Case Is = wdHeaderFooterFirstPage
                            If oHeader.Range.Tables.Count > 0 Then
                                Set oTable = oHeader.Range.Tables(1)
                                'do stuff with otable
                            End If
                        Case Is = wdHeaderFooterEvenPages
                            If oHeader.Range.Tables.Count > 0 Then
                                Set oTable = oHeader.Range.Tables(1)
                                'do stuff with otable
                            End If
                    End Select
                End If
            Next oHeader
        Next oSection
    lbl_Exit:
        Set oSection = Nothing
        Set oHeader = Nothing
        Set oTable = Nothing
        Exit Sub
    End Sub
    Thank you for your answere

    I have try your programme and it gives me the error 5941 in this line:
    oTable.Cell(1, 2).Shading.BackgroundPatternColor = 11382784

    I cant find where the problem is.

  4. #4
    I can't immediately spot where the error might be. The posted code works fine here in the PC version of Office 2007 through to 2016 with a table that has two or more cells in row 1 and the tables are not nested.
    You could try instead
    oTable.Range.Cells(2).Shading.BackgroundPatternColor = 11382784
    but I don't see why it should be necessary.
    If the table is not a simple table, post a sample of a document with the header in question.
    Graham Mayor - MS MVP (Word)
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  5. #5
    VBAX Regular
    Joined
    Feb 2019
    Posts
    14
    Location
    Thank you for the answere.
    It still doesnt work.

    I attach the example word. What I want is the macro color de coloured cell.


    MACRO HEADER TABLE.doc

  6. #6
    OK, you cannot use that method when the table has merged cells. The following however will work with that table whichever header it is in (It is in the first page header in your sample)
    If you want to select which header, then you will need to replace the line

    oTable.Cell(1, 2).Shading.BackgroundPatternColor = 11382784
    with
    oTable.Range.Cells(3).Shading.BackgroundPatternColor = 11382784
    Sub Macro1()
    Dim oSection As Section
    Dim oHeader As HeaderFooter
    Dim oTable As Table
        For Each oSection In ActiveDocument.Sections
            For Each oHeader In oSection.Headers
                If oHeader.Exists Then
                    If oHeader.Range.Tables.Count > 0 Then
                        Set oTable = oHeader.Range.Tables(1)
                        If oHeader.Range.Tables.Count > 0 Then
                            Set oTable = oHeader.Range.Tables(1)
                            oTable.Range.Cells(3).Shading.BackgroundPatternColor = 11382784
                        End If
                    End If
                End If
            Next oHeader
        Next oSection
    lbl_Exit:
        Set oSection = Nothing
        Set oHeader = Nothing
        Set oTable = Nothing
        Exit Sub
    End Sub
    Graham Mayor - MS MVP (Word)
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  7. #7
    VBAX Regular
    Joined
    Feb 2019
    Posts
    14
    Location
    Thank you my friend.

    With your help I finally have finnish my macro and it works perfectly.

    If you ever come to Pamplona i will invite you to have dinner.


    Thanks!!

  8. #8
    VBAX Regular
    Joined
    Feb 2019
    Posts
    14
    Location
    Quote Originally Posted by gmayor View Post
    OK, you cannot use that method when the table has merged cells. The following however will work with that table whichever header it is in (It is in the first page header in your sample)
    If you want to select which header, then you will need to replace the line

    oTable.Cell(1, 2).Shading.BackgroundPatternColor = 11382784
    with
    oTable.Range.Cells(3).Shading.BackgroundPatternColor = 11382784
    Sub Macro1()
    Dim oSection As Section
    Dim oHeader As HeaderFooter
    Dim oTable As Table
        For Each oSection In ActiveDocument.Sections
            For Each oHeader In oSection.Headers
                If oHeader.Exists Then
                    If oHeader.Range.Tables.Count > 0 Then
                        Set oTable = oHeader.Range.Tables(1)
                        If oHeader.Range.Tables.Count > 0 Then
                            Set oTable = oHeader.Range.Tables(1)
                            oTable.Range.Cells(3).Shading.BackgroundPatternColor = 11382784
                        End If
                    End If
                End If
            Next oHeader
        Next oSection
    lbl_Exit:
        Set oSection = Nothing
        Set oHeader = Nothing
        Set oTable = Nothing
        Exit Sub
    End Sub
    Thank you my friend.

    With your help I finally have finnish my macro and it works perfectly.

    If you ever come to Pamplona i will invite you to have dinner.


    Thanks!!

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •