For example:
Code:
Sub Demo()
Application.ScreenUpdating = False
Dim s As Long, HdFt As HeaderFooter, Shp As Shape, Rng As Range
With ActiveDocument
For s = 1 To .Sections.Count
Select Case s
Case 1
For Each HdFt In .Sections(s).Headers
With HdFt
If .Exists Then
If Shp Is Nothing Then
Set Rng = .Range.Characters.First: Rng.Collapse wdCollapseStart
Set Shp = .Shapes.AddTextbox(Orientation:=msoTextOrientationHorizontal, _
Left:=50, Top:=50, Width:=460, Height:=120, Anchor:=Rng)
With Shp
With .Line
.DashStyle = msoLineSolid
.Style = msoLineSingle
.Transparency = 0#
.Visible = msoFalse
End With
With .TextFrame
With .TextRange
.Text = "PROJET"
.Font.Name = "Arial Black"
.Font.Size = 100
.Font.Color = -603923969
End With
.MarginLeft = 0#
.MarginRight = 0.5
.MarginTop = 0#
.MarginBottom = 0#
End With
.Left = wdShapeRight
.WrapFormat.Type = wdWrapBehind
.Rotation = 315
.LockAspectRatio = True
.RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
.RelativeVerticalPosition = wdRelativeHorizontalPositionPage
.Top = 400
.Left = 125
.LockAnchor = True
End With
Else
Set Rng = .Range.Characters.First: Rng.Collapse wdCollapseStart
Rng.FormattedText = Shp.Anchor.FormattedText
End If
End If
End With
Next
Case Else
For Each HdFt In .Sections(s).Headers
With HdFt
If .Exists Then
If .LinkToPrevious = False Then
Set Rng = .Range.Characters.First: Rng.Collapse wdCollapseStart
Rng.FormattedText = Shp.Anchor.FormattedText
End If
End If
End With
Next
End Select
Next
End With
Set Rng = Nothing: Set Shp = Nothing
Application.ScreenUpdating = True
End Sub