Microsoft Office Forums - View Single Post - [Solved] Add Shape on every Header of each Section

Souriane · 12-05-2022, 12:12 PM

Hi!

The following code adds a TextBox on each Header of each Section. It works fine as long as there is no continuous section brakes. When there are continuous section brakes, the code inserts as many TextBoxes as there is continuous section brakes + one more TextBox, and does that on the following section!

So, on my first page, I have 2 continuous sections brakes + 1 section next page = I get on the first page ONE text box, and on the second page FOUR text boxes!

What should I change?

Code:

Sub MyMacro()
    
    Dim oSection As Section
    Dim oHeader As HeaderFooter
    Dim Boite As Shape

    For Each oSection In ActiveDocument.Sections
        For Each oHeader In oSection.Headers
            If oHeader.Exists Then
                
                Set Boite = oHeader.Shapes.AddTextBox( _
                Orientation:=msoTextOrientationHorizontal, _
                Left:=50, Top:=50, Width:=460, Height:=120)
                
                With Boite
                    .TextFrame.TextRange.Text = "PROJET"
                    .TextFrame.TextRange.Font.Name = "Arial Black"
                    .TextFrame.TextRange.Font.Size = 100
                    .TextFrame.TextRange.Font.Color = -603923969
                    .TextFrame.MarginLeft = 0#
                    .TextFrame.MarginRight = 0.5
                    .TextFrame.MarginTop = 0#
                    .TextFrame.MarginBottom = 0#
                    .Line.DashStyle = msoLineSolid
                    .Line.Style = msoLineSingle
                    .Line.Transparency = 0#
                    .Line.Visible = msoFalse
                    .Left = wdShapeRight
                    .WrapFormat.Type = wdWrapBehind
                    .Rotation = 315
                    .LockAspectRatio = True
                    .RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
                    .RelativeVerticalPosition = wdRelativeHorizontalPositionPage
                    .Top = 400
                    .Left = 125
                End With
            End If
        Next oHeader
    Next oSection
End Sub

Thank you!

Souriane