View Single Post
 
Old 07-28-2025, 04:45 PM
macropod's Avatar
macropod macropod is online now Windows 10 Office 2016
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 22,465
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

The problem is that you're not inserting the textbox where you want it, then the code to reposition it fails on the primary (odd) header. A workaround would be:

Code:
Private oSec As Section
Private oShp As Shape

Private Sub DemoNoIssue()
Dim lngIndex As Long, oRng As Range
Application.ScreenUpdating = False
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
    If Not oSec.Headers(lngIndex).LinkToPrevious Then InsertBox lngIndex
  Next lngIndex
Next oSec
Application.ScreenUpdating = True
End Sub

Sub InsertBox(lngHdr As Long)
lngShp As Long
Set oShp = oSec.Headers(lngHdr).Shapes.AddTextbox(msoTextOrientationHorizontal, 337.05, 36, 207#, 27#)
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
  .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
  .TextFrame.TextRange.ParagraphFormat.Alignment = wdAlignParagraphCenter
  .TextFrame.TextRange.Font.Size = 10
  .TextFrame.TextRange.Font.Bold = True
  .TextFrame.TextRange.Text = "Test, Test, Test"
End With
End Sub
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote