Hello,
I have the following code (an InsertFooterPage procedure) that allows me to insert a footer at the end of my document. It is a series of QuickPart fields + a Buildingblock.
However, after inserting the footer, my toggle buttons no longer refresh.
If I delete the footer (using a DeleteFooterPage procedure), the toggle buttons refresh again.
The problem occurs after executing
Code:
For Each oSection In ActiveDocument.Sections
Before this loop, the toggle buttons do not freeze.
- The functions are activated by a checkbox. The checkbox itself does not cause any problems.
- Writing the formula (fields and buildingblock) directly in the footers also creates the same problem.
Has anyone found a solution?
Best regards,
David
Code:
Sub InsertFooterPage ()
Dim oSection As section
Dim oFooter As HeaderFooter
Dim oRng As Range
Application.ScreenUpdating = False
With ActiveDocument.ActiveWindow.View
.SeekView = wdSeekCurrentPageFooter
End With
ActiveWindow.ActivePane.View.ShowFieldCodes = True
For Each oFooter In ActiveDocument.Sections(1).Footers
If oFooter.Exists Then
oFooter.Range.Delete
oFooter.Range.Font.Size = 7
End If
Next oFooter
For Each oSection In ActiveDocument.Sections
For Each oFooter In oSection.Footers
If oFooter.Exists Then
Set oRng = oFooter.Range
With oRng
.Collapse 0
.Fields.Add Range:=oRng, Type:=wdFieldIf, Text:="{PAGE} = {NUMPAGES} {AUTOTEXT}", PreserveFormatting:=False
.Collapse 1
.MoveEndUntil "}"
.End = .End + 1
.MoveStartUntil "{"
.Text = ""
.Fields.Add Range:=oRng, Type:=wdFieldPage, PreserveFormatting:=False
.Collapse 0
.MoveEndUntil "}"
.End = .End + 1
.MoveStartUntil "{"
.Text = ""
.Fields.Add Range:=oRng, Type:=wdFieldNumPages, PreserveFormatting:=False
.Collapse 0
.MoveEndUntil "}"
.End = .End + 1
.MoveStartUntil "{"
.Text = ""
.Fields.Add Range:=oRng, Type:=wdFieldAutoText, Text:="MyBuildingBlock3", PreserveFormatting:=False
.Fields.Update
End With
End If
Next oFooter
Next oSection
ActiveWindow.View.ShowFieldCodes = False
With ActiveWindow.View
.Type = wdPrintView
.SeekView = wdSeekMainDocument
End With
Application.ScreenUpdating = True
If Not objRibbon Is Nothing Then
objRibbon.Invalidate
End If
GoTo Sortir
Sortir:
On Error Resume Next
If Not oSection Is Nothing Then Set oSection = Nothing
If Not oFooter Is Nothing Then Set oFooter = Nothing
If Not oRng Is Nothing Then Set oRng = Nothing
Exit Sub
End Sub