Option Explicit
Private oSec As Section
Private oRng As Range
Private oShp As Shape
Private lngShp As Long
Private Sub DemoIssue()
Dim oRngStart As Range
Dim lngIndex As Long, lngSect
  Application.ScreenUpdating = False
  'Set oRngStart = Selection.Range
  'Set oRng = ActiveDocument.Range
  'oRng.Collapse wdCollapseEnd
  'oRng.Select
  For Each oSec In ActiveDocument.Sections
    For lngIndex = 1 To 3
      Set oRng = oSec.Headers(lngIndex).Range
      For Each oShp In oRng.ShapeRange
        If InStr(oShp.Name, "PrivBox_") = 1 Then oShp.Delete
      Next
    Next lngIndex
  Next oSec
  For Each oSec In ActiveDocument.Sections
    For lngIndex = 1 To 3
      If Not oSec.Headers(lngIndex).LinkToPrevious Then
        InsertBox lngIndex
        'DoEvents
      End If
    Next lngIndex
  Next oSec
  'oRngStart.Select
  Application.ScreenUpdating = True
  Application.ScreenRefresh
lbl_Exit:
  Exit Sub
End Sub
Sub InsertBox(lngHdr As Long)
Dim i As Long
  Set oShp = oSec.Headers(lngHdr).Shapes.AddTextbox(msoTextOrientationHorizontal, 337.05, 72.2, 207#, 27#)
  DoEvents
  With oShp
    .Name = "PrivBox_" & lngShp
     lngShp = lngShp + 1
    .Fill.Visible = msoTrue
    .Fill.Solid
    .Fill.ForeColor.RGB = RGB(255, 255, 255)
    .Fill.Transparency = 0#
    .Line.Weight = 2#
    .Line.DashStyle = msoLineSolid
    .Line.Style = msoLineThinThin
    .Line.Transparency = 0#
    .Line.Visible = msoTrue
    .Line.ForeColor.RGB = RGB(0, 0, 0)
    .Line.BackColor.RGB = RGB(255, 255, 255)
    .LockAspectRatio = msoFalse
    .TextFrame.MarginLeft = 7.2
    .TextFrame.MarginRight = 7.2
    .TextFrame.MarginTop = 3.6
    .TextFrame.MarginBottom = 3.6
    .RelativeHorizontalPosition = wdRelativeHorizontalPositionColumn
    .RelativeVerticalPosition = wdRelativeVerticalPositionParagraph
    .Left = InchesToPoints(3.68)
    .Top = InchesToPoints(0)
    .LockAnchor = False
    .LayoutInCell = True
    .WrapFormat.AllowOverlap = True
    .WrapFormat.Side = wdWrapBoth
    .WrapFormat.DistanceTop = InchesToPoints(0)
    .WrapFormat.DistanceBottom = InchesToPoints(0)
    .WrapFormat.DistanceLeft = InchesToPoints(0.13)
    .WrapFormat.DistanceRight = InchesToPoints(0.13)
    .WrapFormat.Type = 3
    .ZOrder 4
    .TextFrame.AutoSize = True
    .TextFrame.WordWrap = True
    Set oRng = .TextFrame.TextRange
  End With
  With oRng
    .ParagraphFormat.Alignment = wdAlignParagraphCenter
    .Font.Size = 10
    .Font.Bold = True
    .Text = "Test, Test, Test"
  End With
  Application.ScreenRefresh
lbl_Exit:
  Exit Sub
End Sub