fill headings via vba

[wolle271]

cheers guys,

i have a word document and im trying to fill the headings on each page of it. the header looks like this:

header.jpg


my biggest problem is, that i dont know how to access the 3 different parts of the header separately...
so the macro should put something into the header part thats most to the left and then put something different into the centered header part.
does anybody have an idea how to solve this?

[gmayor]

Assuming the image represents a single row table then

Sub FillHeader()
Dim oSection As Section
Dim oHeader As HeaderFooter
Dim oTable As Table
Dim oCell As Range
    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)
                    Set oCell = oTable.Rows(1).Cells(1).Range
                    oCell.End = oCell.End - 1
                    oCell.Text = "Left part text"
                    Set oCell = oTable.Rows(1).Cells(2).Range
                    oCell.End = oCell.End - 1
                    oCell.Text = "Middle part text"
                    Set oCell = oTable.Rows(1).Cells(3).Range
                    oCell.End = oCell.End - 1
                    oCell.Text = "Right part text"
                End If
            End If
        Next oHeader
    Next oSection
End Sub

The macro shows all three cells. If you only want the left and centre remove the lines

Set oCell = oTable.Rows(1).Cells(3).Range
oCell.End = oCell.End - 1
oCell.Text = "Right part text"

[wolle271]

cheers man,

thx for your reply.
i forgot to mention that im accessing the word document via an excel macro. the document in which these headers need to be written is saved in a variable:

Dim objDocTgt
Set objDocTgt = objWord.Documents.Add("xxx.dotx")

i would be really happy if you could help me.

thx!

[gmayor]

It only needs minor changes primarily with the declarations for it to work in Excel, assuming that the table is already present in the template.

Sub FillHeader()
Dim objWord As Object
Dim objDocTgt As Object
Dim oSection As Object
Dim oHeader As Object
Dim oTable As Object
Dim oCell As Object

    On Error Resume Next
    Set objWord = GetObject(, "Word.Application")
    If Err Then
        Set objWord = CreateObject("Word.Application")
    End If
    On Error GoTo 0
    Set objDocTgt = objWord.Documents.Add("C:\Path\xxx.dotx")

    For Each oSection In objDocTgt.Sections
        For Each oHeader In oSection.Headers
            If oHeader.Exists Then
                If oHeader.Range.Tables.Count > 0 Then
                    Set oTable = oHeader.Range.Tables(1)
                    Set oCell = oTable.Rows(1).Cells(1).Range
                    oCell.End = oCell.End - 1
                    oCell.Text = "Left part text" 'Replace with the appropriate value
                    Set oCell = oTable.Rows(1).Cells(2).Range
                    oCell.End = oCell.End - 1
                    oCell.Text = "Middle part text" 'Replace with the appropriate value
                    Set oCell = oTable.Rows(1).Cells(3).Range
                    oCell.End = oCell.End - 1
                    oCell.Text = "Right part text" 'Replace with the appropriate value
                End If
            End If
        Next oHeader
    Next oSection
End Sub

[wolle271]

awesome! works fine!