View Single Post
 
Old 12-05-2022, 03:46 PM
macropod's Avatar
macropod macropod is offline Windows 10 Office 2016
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 22,382
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

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
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote