Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations SkipVought on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

add header and footer from building blocks based on input

Status
Not open for further replies.

SAToronto

IS-IT--Management
Sep 21, 2011
199
0
0
CA
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

 
Try:
Code:
Sub AutoNew()
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), ""))
  MsgBox strCity
Select Case strCity
  Case "Toronto", "Ottawa", "London", "Edmonton", _
    "Calgary", "Kelowna", "Vancouver", "Victoria"
    ChangeHeaderFooter strCity & "Header", False
    ChangeHeaderFooter strCity & "Footer", True
 Case Else
 MsgBox "City header/footer not available"
End Select
End Sub

Function ChangeHeaderFooter(strCity As String, bFooter As Boolean, Optional Primary As Boolean)
Dim oFld As Field, oRng As Range
With ActiveDocument
  If Not .PageSetup.DifferentFirstPageHeaderFooter = True Then Primary = True
  With .Sections.First
    If Primary = True Then
      If bFooter = True Then
        Set oRng = .Footers(wdHeaderFooterPrimary).Range
      Else
        Set oRng = .Headers(wdHeaderFooterPrimary).Range
      End If
    Else
      If bFooter = True Then
        Set oRng = .Footers(wdHeaderFooterFirstPage).Range
      Else
        Set oRng = .Headers(wdHeaderFooterFirstPage).Range
      End If
    End If
  End With
End With
For Each oFld In oRng.Fields
  With oFld
    If .Type = wdFieldAutoText Then
      .Locked = False
      .Code.Text = "AUTOTEXT " & strCity
      .Update
      .Locked = True
      Exit For
    End If
  End With
Next oFld
End Function
Note: Your Select Case test has an entry for 'TorontoHeader'. Somehow I don't think it's meant to be that...

Cheers
Paul Edstein
[MS MVP - Word]
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top