I am trying to use the code below to populate header and footer in word 2010/13 based on city that is input
I have saved all my city headers/footers as autotext via the building blocks organizer but this code given to me doesn't seem to work
On my template in the header I have {AUTOTEXT TorontoHeader} and in footer {AUTOTEXT TorontoFooter}
When I run the code and input TorontoHeader its telling me that the header and footer are unavailable
Option Explicit
Function ChangeHeaderFooter(strCity As String, bFooter As Boolean, Optional Primary As Boolean)
Dim oFld As Field
Dim oRng As Word.Range
If Not ActiveDocument.PageSetup.DifferentFirstPageHeaderFooter = True Then
Primary = True
End If
If Primary = True Then
If bFooter = True Then
Set oRng = ActiveDocument.StoryRanges(wdPrimaryFooterStory)
Else
Set oRng = ActiveDocument.StoryRanges(wdPrimaryHeaderStory)
End If
Else
If bFooter = True Then
Set oRng = ActiveDocument.StoryRanges(wdFirstPageFooterStory)
Else
Set oRng = ActiveDocument.StoryRanges(wdFirstPageHeaderStory)
End If
End If
For Each oFld In oRng.Fields
If oFld.Type = wdFieldAutoText Then
oFld.Locked = False
oFld.Code.Text = Replace(oFld.Code, oFld.Code.Text, "AUTOTEXT " & strCity)
oFld.Update
oFld.Locked = True
Exit For
End If
Next oFld
End Function
Sub AutoNew()
GetLogos
End Sub
Sub GetLogos()
Dim strCity As String
strCity = StrConv(InputBox("Enter Your City. eg: Toronto, Vancouver. Case sensitive: All cities begin with Uppercase Letter"), vbProperCase)
strCity = Trim(Replace(strCity, Chr(32), ""))
Select Case True
Case strCity = "TorontoHeader", _
strCity = "Ottawa", _
strCity = "London", _
strCity = "Edmonton", _
strCity = "Calgary", _
strCity = "Kelowna", _
strCity = "Vancouver", _
strCity = "Victoria"
ChangeHeaderFooter strCity & "Header", False
ChangeHeaderFooter strCity & "Footer", True
Case Else
MsgBox "City header/footer not available"
End Select
End Sub
I have saved all my city headers/footers as autotext via the building blocks organizer but this code given to me doesn't seem to work
On my template in the header I have {AUTOTEXT TorontoHeader} and in footer {AUTOTEXT TorontoFooter}
When I run the code and input TorontoHeader its telling me that the header and footer are unavailable
Option Explicit
Function ChangeHeaderFooter(strCity As String, bFooter As Boolean, Optional Primary As Boolean)
Dim oFld As Field
Dim oRng As Word.Range
If Not ActiveDocument.PageSetup.DifferentFirstPageHeaderFooter = True Then
Primary = True
End If
If Primary = True Then
If bFooter = True Then
Set oRng = ActiveDocument.StoryRanges(wdPrimaryFooterStory)
Else
Set oRng = ActiveDocument.StoryRanges(wdPrimaryHeaderStory)
End If
Else
If bFooter = True Then
Set oRng = ActiveDocument.StoryRanges(wdFirstPageFooterStory)
Else
Set oRng = ActiveDocument.StoryRanges(wdFirstPageHeaderStory)
End If
End If
For Each oFld In oRng.Fields
If oFld.Type = wdFieldAutoText Then
oFld.Locked = False
oFld.Code.Text = Replace(oFld.Code, oFld.Code.Text, "AUTOTEXT " & strCity)
oFld.Update
oFld.Locked = True
Exit For
End If
Next oFld
End Function
Sub AutoNew()
GetLogos
End Sub
Sub GetLogos()
Dim strCity As String
strCity = StrConv(InputBox("Enter Your City. eg: Toronto, Vancouver. Case sensitive: All cities begin with Uppercase Letter"), vbProperCase)
strCity = Trim(Replace(strCity, Chr(32), ""))
Select Case True
Case strCity = "TorontoHeader", _
strCity = "Ottawa", _
strCity = "London", _
strCity = "Edmonton", _
strCity = "Calgary", _
strCity = "Kelowna", _
strCity = "Vancouver", _
strCity = "Victoria"
ChangeHeaderFooter strCity & "Header", False
ChangeHeaderFooter strCity & "Footer", True
Case Else
MsgBox "City header/footer not available"
End Select
End Sub