Problem with insert a footer at the end of my doc (a series of QuickPart fields + a Buildingblock)

Ddadoo57 · #1 11-26-2025, 08:11 AM

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

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Sorting Charts - series custom color problem	Rhene	Excel	0	08-02-2017 11:20 AM
Run-time error '-2147467259 (80004005)': Method 'Insert' of object 'BuildingBlock' failed	Katherine1995	Word VBA	6	11-17-2016 12:04 PM
INSERT building blocks from Quickpart in word	jasserin	Word VBA	0	06-05-2013 12:55 PM
Need help with quickparts(fields) in footer	Nighthawk	Word	2	08-22-2012 05:13 AM
Sorting or an Excel formula to insert a blank row after ending a series.	PRADEEPB270	Excel	1	09-07-2011 02:33 AM