View Single Post
 
Old 11-26-2025, 08:11 AM
Ddadoo57 Ddadoo57 is offline Windows 11 Office 2021
Advanced Beginner
 
Join Date: Feb 2023
Posts: 94
Ddadoo57 is on a distinguished road
Default Problem with insert a footer at the end of my doc (a series of QuickPart fields + a Buildingblock)

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
Reply With Quote