While correct in this case, I typically take what Microsoft documentation has to say about methods and properties with a grain of salt. True, I appears that the anchor can't be set with VBA and is "read only" as both you and the article has stated.
You mention "bug" in the GroupItems feature. Here at least, the Item method of GroupItems has failed and I couldn't do anything with it.
While I cannot explain why
Grouped Shapes Not Anchoring to Original Paragraph in Word VBA, if I understand what your objective is, I might be able to offer a solution.
It appears that your have these multiple shaperanges with three (or in one case two) lines of text. Your goal is to adjust the width of the center shape to fit the text width of the last line in the shape. I'll call this the line of interest or variable width text line.
As we have seen, regardless of the hours trying to understand why and prevent, when the shaperange is ungrouped and regrouped the anchor shifts from your targeted line of interest to the top line in the applicable section. Seems there is nothing we can do to prevent that.
So, lets accept that our shapes are going to be anchored there anyway and start out with them anchored there. Now our problem is to a) find the shape and b) find the line of interest in that shape to use to calculate required center shape with.
I have done that in the attached PRUEBAS file. Now, your right to left text, and mix of English and Hebrew and perhaps even your styles caused me no end of frustration, but the process seems to meet the objective as I understand it.
Here is that code. You will need to revise it to meet all of your conditional requirements:
Code:
Sub MACRO5()
Dim shpGroup As ShapeRange
Dim C As Shape, L As Shape, R As Shape
Dim oPar As Paragraph
Dim oRng As Range
Dim oShp As Shape
For Each oPar In ActiveDocument.Paragraphs
If oPar.Range.ShapeRange.Count > 0 Then
'The ShapeRanges in this document are anchored to the first paragraph in the sections.
Set oRng = oPar.Range
'Now we need to move the range down to the paragraph of interest e.g., the second or third
'paragraphs covered by the shape range (or where you previoiusly had them anchored)
Do Until Len(oRng.Paragraphs(1).Range.Text) > 1
oRng.Move wdParagraph, 1
Loop
'We have now found the first paragraph with text. Some of your shaperanges have three lines
'where the second line is very small and formatted with a font named "Fb Livorna"
If oRng.Paragraphs.Last.Next.Range.Font.Name = "Fb Livorna" Then
'Move down 2 paragrphs.
oRng.Move wdParagraph, 2
Else
'Your fourth shape does not have the "Fb Livorna" paragraph
oRng.Move wdParagraph, 1
End If
'Now we have the paragraph of interest and need to determine how wide the
'center shape should be. This is a convoluted process and perhaps due to your right to left text,
'or styles applied. Regardless it works here.
oRng.Paragraphs(1).Range.Characters.Last.Previous.Select
PRINCIPIO = Selection.Information(wdHorizontalPositionRelativeToTextBoundary)
oRng.Paragraphs(1).Range.Characters(1).Select
Selection.EndKey
FIN = Selection.Information(wdHorizontalPositionRelativeToTextBoundary)
TAMANO = PRINCIPIO - FIN
oPar.Range.ShapeRange(1).Select
Set shpGroup = Selection.ShapeRange
shpGroup.Ungroup
For Each oShp In shpGroup
If oShp.Name = "1" Then Set L = oShp
If oShp.Name = "2" Then Set C = oShp
If oShp.Name = "3" Then Set R = oShp
Next
C.LockAspectRatio = msoFalse
C.Width = TAMANO
C.Left = C.Left - ADDITION_IN_EACH_SIDE
L.Left = C.Left - L.Width
R.Left = C.Left + C.Width
shpGroup.Group
shpGroup.Left = wdShapeCenter
End If
Next
lbl_Exit:
Exit Sub
End Sub
I have also attached Resize 3 part shape to fit text as and English left to right text example. Which for some inexplicable reason, it seemed much easier to calculate the required shape width. In this example I have named the shpGroup "Banner" and the three component parts "Left, Right and Center." I Have also used Range more that Selection. Here is that code:
Code:
Sub Resize3PartShapeToText()
Dim oPar As Paragraph
Dim shpGroup As ShapeRange
Dim C As Shape, L As Shape, R As Shape
Dim oRng As Range, oRngEval As Range
Dim oShp As Shape
Dim lngPositStart As Long, lngPositEnd As Long
Application.ScreenUpdating = False
For Each oPar In ActiveDocument.Paragraphs
If oPar.Range.ShapeRange.Count > 0 Then
If oPar.Range.ShapeRange(1).Name = "Banner" Then
Set oRng = oPar.Range
oRng.Select
Do Until Len(oRng.Paragraphs(1).Range.Text) > 1
'Finds the Fixed Line
oRng.Move wdParagraph, 1
Loop
'Get the variable text line.
oRng.Move wdParagraph, 1
Set oRngEval = oRng.Paragraphs(1).Range.Duplicate
oRngEval.Collapse wdCollapseStart
lngPositStart = oRngEval.Information(wdHorizontalPositionRelativeToTextBoundary)
Set oRngEval = oRng.Paragraphs(1).Range.Duplicate
oRngEval.Collapse wdCollapseEnd
oRngEval.Move wdCharacter, -1
lngPositEnd = oRngEval.Information(wdHorizontalPositionRelativeToTextBoundary)
Set shpGroup = oPar.Range.ShapeRange
shpGroup.Ungroup
For Each oShp In shpGroup
Select Case oShp.Name
Case "Left": Set L = oShp
Case "Center": Set C = oShp
Case "Right": Set R = oShp
End Select
Next
C.LockAspectRatio = msoFalse
C.Width = lngPositEnd - lngPositStart
C.Left = C.Left
L.Left = C.Left - L.Width
R.Left = C.Left + C.Width
shpGroup.Group
shpGroup.Name = "Banner"
shpGroup.Left = wdShapeCenter
shpGroup.Height = 99.5
End If
End If
Next
Application.ScreenUpdating = True
lbl_Exit:
Exit Sub
End Sub
This is about all I can offer. Perhaps as you say, macropod will come along with the answer. Good Luck.