Frosty
06-22-2012, 02:33 PM
Soliciting feedback and potentially helping someone who comes along to deal with header footer ranges. Anything anyone would add or feels is missing from this functionality? Are there circumstances where this would break (I've deliberately left out error trapping, at least for now).
Sub DemoInsertText
Dim rngWhere As Range
For Each rngWhere In fnHeaderAndFooterRanges
rngWhere.Text = "Hello World"
Next
End Sub
and then an extension of more easily identifying headers/footers or both...
'a way of identifying desired header or footer ranges
Public Enum HeaderFooterRangeTypes
All
FirstPage
Primary
FirstAndPrimary
EvenPage
End Enum
'----------------------------------------------------------------------------------------------------------
' Return the specified collection Header AND Footer ranges.
' DEFAULTS: First Page and Primary Header and Footer ranges in ActiveDocument
'----------------------------------------------------------------------------------------------------------
Public Function fnHeaderAndFooterRanges(Optional lRangeType As HeaderFooterRangeTypes = FirstAndPrimary, _
Optional oInDoc As Document, _
Optional blIncludeHidden As Boolean = False) As Collection
Dim colRet As Collection
Dim rngHF As Range
'if we didn't pass in a document to work on...
If oInDoc Is Nothing Then
Set oInDoc = ActiveDocument
End If
'initialize our collection
Set colRet = New Collection
'get the header ranges
For Each rngHF In fnHeaderRanges(lRangeType, oInDoc, blIncludeHidden)
colRet.Add rngHF.Duplicate
Next
'and the footer ranges
For Each rngHF In fnFooterRanges(lRangeType, oInDoc, blIncludeHidden)
colRet.Add rngHF.Duplicate
Next
'return the collection
Set fnHeaderAndFooterRanges = colRet
End Function
'----------------------------------------------------------------------------------------------------------
' Return the specified collection Header ranges.
' DEFAULTS: First Page and Primary Header ranges in ActiveDocument
'----------------------------------------------------------------------------------------------------------
Public Function fnHeaderRanges(Optional lRangeType As HeaderFooterRangeTypes = FirstAndPrimary, _
Optional oInDoc As Document, _
Optional blIncludeHidden As Boolean = False) As Collection
Dim oSec As Section
Dim hf As HeaderFooter
Dim colRet As Collection
'work on the activedocument if nothing was passed
If oInDoc Is Nothing Then
Set oInDoc = ActiveDocument
End If
'initialize our return collection
Set colRet = New Collection
'go through the header/footer objects
For Each oSec In oInDoc.Sections
For Each hf In oSec.Headers
'if this header matches the desired range type, add to the collection
If fnHFMatches(hf, lRangeType, blIncludeHidden) Then
colRet.Add hf.Range.Duplicate
End If
Next
Next
'return the collection
Set fnHeaderRanges = colRet
End Function
'----------------------------------------------------------------------------------------------------------
' Return the specified collection Footer ranges.
' DEFAULTS: First and Primary Footer ranges in ActiveDocument
'----------------------------------------------------------------------------------------------------------
Public Function fnFooterRanges(Optional lRangeType As HeaderFooterRangeTypes = FirstAndPrimary, _
Optional oInDoc As Document, _
Optional blIncludeHidden As Boolean = False) As Collection
Dim oSec As Section
Dim hf As HeaderFooter
Dim colRet As Collection
'work on the activedocument if nothing was passed
If oInDoc Is Nothing Then
Set oInDoc = ActiveDocument
End If
'initialize our return collection
Set colRet = New Collection
'go through the header/footer objects
For Each oSec In oInDoc.Sections
For Each hf In oSec.Footers
'if this header matches the desired range type, add to the collection
If fnHFMatches(hf, lRangeType, blIncludeHidden) Then
colRet.Add hf.Range.Duplicate
End If
Next
Next
'return the collection
Set fnFooterRanges = colRet
End Function
'----------------------------------------------------------------------------------------------------------
' returns whether the passed header/footer type matches the specified range type
' Returns FALSE if the hf is linked to previous
' Returns FALSE if the hf is specified, but the containing section is not displaying that hf
' example: hf is first page type, but .DifferentFirstPageHeaderFooter = False
'----------------------------------------------------------------------------------------------------------
Public Function fnHFMatches(hf As HeaderFooter, _
lRangeType As HeaderFooterRangeTypes, _
blIncludeHidden As Boolean) As Boolean
'we don't bother including LINKED headers/footers
'Also: if we have specified to ignore "hidden" header/footers,
' we test if the type of HF passed is being used via the page setup
If hf.LinkToPrevious = True Or blIncludeHidden = False Then
With hf.Parent.PageSetup
'if first page and no different first page
'OR if even page and no odd/even headers/footers, then forget it
If hf.Index = wdHeaderFooterFirstPage And .DifferentFirstPageHeaderFooter = False _
Or hf.Index = wdHeaderFooterEvenPages And .OddAndEvenPagesHeaderFooter = False Then
'exit our function
GoTo l_exit
End If
End With
End If
'Evalutate the type of range desired vs. the type of range passed
Select Case lRangeType
'any unlinked footer
Case All
fnHFMatches = True
'any unlinked first page or primary footer
Case FirstAndPrimary
If hf.Index = wdHeaderFooterFirstPage _
Or hf.Index = wdHeaderFooterPrimary Then
fnHFMatches = True
End If
'any unlinked first page footer
Case FirstPage
If hf.Index = wdHeaderFooterFirstPage Then
fnHFMatches = True
End If
'any unlinked primary footer
Case Primary
If hf.Index = wdHeaderFooterPrimary Then
fnHFMatches = True
End If
'any unlinked even footer
Case EvenPage
If hf.Index = wdHeaderFooterEvenPages Then
fnHFMatches = True
End If
Case Else
'not a match
End Select
l_exit:
End Function
Sub DemoInsertText
Dim rngWhere As Range
For Each rngWhere In fnHeaderAndFooterRanges
rngWhere.Text = "Hello World"
Next
End Sub
and then an extension of more easily identifying headers/footers or both...
'a way of identifying desired header or footer ranges
Public Enum HeaderFooterRangeTypes
All
FirstPage
Primary
FirstAndPrimary
EvenPage
End Enum
'----------------------------------------------------------------------------------------------------------
' Return the specified collection Header AND Footer ranges.
' DEFAULTS: First Page and Primary Header and Footer ranges in ActiveDocument
'----------------------------------------------------------------------------------------------------------
Public Function fnHeaderAndFooterRanges(Optional lRangeType As HeaderFooterRangeTypes = FirstAndPrimary, _
Optional oInDoc As Document, _
Optional blIncludeHidden As Boolean = False) As Collection
Dim colRet As Collection
Dim rngHF As Range
'if we didn't pass in a document to work on...
If oInDoc Is Nothing Then
Set oInDoc = ActiveDocument
End If
'initialize our collection
Set colRet = New Collection
'get the header ranges
For Each rngHF In fnHeaderRanges(lRangeType, oInDoc, blIncludeHidden)
colRet.Add rngHF.Duplicate
Next
'and the footer ranges
For Each rngHF In fnFooterRanges(lRangeType, oInDoc, blIncludeHidden)
colRet.Add rngHF.Duplicate
Next
'return the collection
Set fnHeaderAndFooterRanges = colRet
End Function
'----------------------------------------------------------------------------------------------------------
' Return the specified collection Header ranges.
' DEFAULTS: First Page and Primary Header ranges in ActiveDocument
'----------------------------------------------------------------------------------------------------------
Public Function fnHeaderRanges(Optional lRangeType As HeaderFooterRangeTypes = FirstAndPrimary, _
Optional oInDoc As Document, _
Optional blIncludeHidden As Boolean = False) As Collection
Dim oSec As Section
Dim hf As HeaderFooter
Dim colRet As Collection
'work on the activedocument if nothing was passed
If oInDoc Is Nothing Then
Set oInDoc = ActiveDocument
End If
'initialize our return collection
Set colRet = New Collection
'go through the header/footer objects
For Each oSec In oInDoc.Sections
For Each hf In oSec.Headers
'if this header matches the desired range type, add to the collection
If fnHFMatches(hf, lRangeType, blIncludeHidden) Then
colRet.Add hf.Range.Duplicate
End If
Next
Next
'return the collection
Set fnHeaderRanges = colRet
End Function
'----------------------------------------------------------------------------------------------------------
' Return the specified collection Footer ranges.
' DEFAULTS: First and Primary Footer ranges in ActiveDocument
'----------------------------------------------------------------------------------------------------------
Public Function fnFooterRanges(Optional lRangeType As HeaderFooterRangeTypes = FirstAndPrimary, _
Optional oInDoc As Document, _
Optional blIncludeHidden As Boolean = False) As Collection
Dim oSec As Section
Dim hf As HeaderFooter
Dim colRet As Collection
'work on the activedocument if nothing was passed
If oInDoc Is Nothing Then
Set oInDoc = ActiveDocument
End If
'initialize our return collection
Set colRet = New Collection
'go through the header/footer objects
For Each oSec In oInDoc.Sections
For Each hf In oSec.Footers
'if this header matches the desired range type, add to the collection
If fnHFMatches(hf, lRangeType, blIncludeHidden) Then
colRet.Add hf.Range.Duplicate
End If
Next
Next
'return the collection
Set fnFooterRanges = colRet
End Function
'----------------------------------------------------------------------------------------------------------
' returns whether the passed header/footer type matches the specified range type
' Returns FALSE if the hf is linked to previous
' Returns FALSE if the hf is specified, but the containing section is not displaying that hf
' example: hf is first page type, but .DifferentFirstPageHeaderFooter = False
'----------------------------------------------------------------------------------------------------------
Public Function fnHFMatches(hf As HeaderFooter, _
lRangeType As HeaderFooterRangeTypes, _
blIncludeHidden As Boolean) As Boolean
'we don't bother including LINKED headers/footers
'Also: if we have specified to ignore "hidden" header/footers,
' we test if the type of HF passed is being used via the page setup
If hf.LinkToPrevious = True Or blIncludeHidden = False Then
With hf.Parent.PageSetup
'if first page and no different first page
'OR if even page and no odd/even headers/footers, then forget it
If hf.Index = wdHeaderFooterFirstPage And .DifferentFirstPageHeaderFooter = False _
Or hf.Index = wdHeaderFooterEvenPages And .OddAndEvenPagesHeaderFooter = False Then
'exit our function
GoTo l_exit
End If
End With
End If
'Evalutate the type of range desired vs. the type of range passed
Select Case lRangeType
'any unlinked footer
Case All
fnHFMatches = True
'any unlinked first page or primary footer
Case FirstAndPrimary
If hf.Index = wdHeaderFooterFirstPage _
Or hf.Index = wdHeaderFooterPrimary Then
fnHFMatches = True
End If
'any unlinked first page footer
Case FirstPage
If hf.Index = wdHeaderFooterFirstPage Then
fnHFMatches = True
End If
'any unlinked primary footer
Case Primary
If hf.Index = wdHeaderFooterPrimary Then
fnHFMatches = True
End If
'any unlinked even footer
Case EvenPage
If hf.Index = wdHeaderFooterEvenPages Then
fnHFMatches = True
End If
Case Else
'not a match
End Select
l_exit:
End Function