Flummoxed by Shape Position Behavior

gmaxey · #1 07-27-2025, 10:37 AM

I am struggling to understand the behavior I see while attempting to position shapes in the headers of a document.

I have a simple document with layout different first page and different odd and even pages. There is no text in the headers and the document content consist only of enough empty paragraphs to show all three headers.

The purpose of the code is to insert three identical shapes (with text) at the same position in each header (First Page, Even Page, Primary page).

Here is the code. Note - the stetted lines are there a a work around for the problem:

Code:

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

If I run the code with the cursor in the first page content, the First Page shape is positioned correctly but in the the Even Page and Primary Page the shape is positioned .5 inches below the proper location.

If I run the code with the cursor in the Even page content, the First Page shape and Even Page shape are positioned correctly but in the Odd Page the shape is positioned .5 inches below the proper location.

If I run the code with the cursor in the Odd page content then the shape is properly positioned in all three headers.

That seems weird. What is weirder however, is if I put a Stop anywhere in the code and run it and proceed each time the stop is hit, all shapes are properly positioned regardless of which page the cursor is in.

Unstetting the lines in the code ensures the last page (or Odd Page) content is selected and the process runs without issue.

Any able to explain this behavior?

macropod · #2 07-28-2025, 04:45 PM

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

gmaxey · #3 07-29-2025, 04:59 AM

Paul,

Thanks. Poor description of the problem on my end. I realized that it was the repositioning steps that were failing. What I was looking for is some understanding of why if fails?

Why it fails if 1) starting with the selection in the first page content and not if in the odd page content and 2) why if fails when running the code and not if stepping through.

Code:

Private Sub DemoIssue()
Dim oRngStart As Range
Dim lngIndex As Long, lngSect
  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
    Next lngIndex
  Next oSec
  For Each oSec In ActiveDocument.Sections
    For lngIndex = 1 To 3
      If Not oSec.Headers(wdHeaderFooterPrimary).LinkToPrevious Then
        InsertBox lngIndex
        If lngIndex = 1 Then Set oShpDup = oShp
        'DoEvents
      End If
    Next lngIndex
  Next oSec
  'But why does it fail? Using the origianal position 337.05, 72.2, 207#, 27# in the InsertBox procedure
  'Run the code with this Stop
  'Stop
  'Then step through and the Odd page is positioned correctly.
  'Remove the stop ans run the code.
  With oShpDup
    Debug.Print .Left & " - " & .Top
    .RelativeHorizontalPosition = wdRelativeHorizontalPositionColumn
    .RelativeVerticalPosition = wdRelativeVerticalPositionParagraph
    .Left = InchesToPoints(3.68)
    .Top = InchesToPoints(0)
    Debug.Print .Left & " - " & .Top
  End With
  Application.ScreenUpdating = True
  Application.ScreenRefresh
lbl_Exit:
  Exit Sub
End Sub

macropod · #4 07-29-2025, 06:30 AM

They 'why' it fails is likely due to a VBA timing bug. Since it also seems to depend on what's selected when you run the code, I wonder if selecting the headers as you loop through them will change the behaviour?

gmaxey · #5 07-29-2025, 08:28 AM

Paul,

Yes it will. Selecting the header range results in normal behavior. A strange one indeed.

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Image imported into word Shape is smaller than the shape and not centered	drwin	Drawing and Graphics	1	09-21-2023 11:33 AM
Get the position of a string from the cursor position forward	alex100	Word VBA	2	02-22-2023 02:48 AM
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
Puzzling behavior by Window shape in [Walls, Shell and Structure]	csdlman	Visio	3	06-12-2018 03:50 AM
Textboxes position isn't equal to initial position	dxdevil	Word VBA	0	01-30-2017 04:32 AM