Add Shape on every Header of each Section

Souriane · #1 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

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
When I copy a shape into another document it becomes a picture. I want a shape.	FJM	Word	4	02-24-2022 09:59 AM
Visio 2016 New homemade Shape Data export with Network Shape Data	Karlderxte	Visio	1	08-17-2021 04:04 PM
Fit text to shape / Place table in shape	Floppy	PowerPoint	0	04-01-2021 11:01 AM
Word Mac 2010 VBA Draw shape shortcut, irregular shape, draw without graphics tablet like in paint	AnonA2	Word VBA	0	11-24-2020 04:21 PM
How to change size / shape of a shape in a stencil	tomgoodell	Visio	1	06-30-2016 04:40 AM