Hi,
I would like to be able to autonumber figures (grouped autoshapes etc), just like LaTex does for example.
So, I added a caption (from the insert menu) to my figure and grouped the caption with it.
Unfortunately, (due to a Bug?) Word does not update the fields inside a grouped object. It seems such a basic thing, numbering figures, but Word does not seem to support this.
I wrote a macro to ungroup all shapes (it does not work if I ungroup one shape at a time), remember the original groups, update all fields, and regroup.
The macro almost works, but the problem is that once ungrouped, the parts often scatter all over the document. If I regroup, parts don't always regroup in the same combination, and rarely does the regrouped shape appears at the original location again.
This is my macro so far. I only learned VBA a day ago, so the code may not be that fancy. I hope someone can suggest an improvement, or perhaps knows of another way of numbering figures.
Sub updateFigures()
Dim shapeArray(1 To 50) As ShapeRange
Dim totalGroups As Integer
Dim bla As Collection
Dim sShape As Shapes
Dim qwe As ShapeRange
Dim myshape As ShapeRange
Dim nCounter As Integer
Dim origShapeArray(1 To 50) As Shape 'how to set a dynamic size ?
Dim origAnchorArray(1 To 50) As Range 'for now, 50 will do
Dim dupShape As Shape
totalGroups = 0
Set sShape = ActiveDocument.Shapes
For nCounter = sShape.Count To 1 Step -1
' ungroup all grouped shapes
If (sShape(nCounter).Type = Office.MsoShapeType.msoGroup) Then
totalGroups = totalGroups + 1
'selecting Anchor prevents scattering of parts a bit
sShape(nCounter).Anchor.Paragraphs(1).Range.Select
Set origAnchorArray(totalGroups) = sShape(nCounter).Anchor
'remember original shape, doesn't help much...
Set dupShape = sShape(nCounter).Duplicate
dupShape.Visible = msoFalse
Set origShapeArray(totalGroups) = dupShape
Set qwe = sShape(nCounter).Ungroup
Set shapeArray(totalGroups) = qwe
End If
Next nCounter
' update all fields if shapes have text
For nCounter = 1 To totalGroups Step 1
Set myshape = shapeArray(nCounter)
Dim groupCnt As Integer
For groupCnt = myshape.Count To 1 Step -1
If myshape(groupCnt).TextFrame.HasText Then
myshape(groupCnt).Select
Selection.WholeStory
Selection.Fields.Update
End If
Next groupCnt
Next nCounter
Dim regroupedShape As Shape
Dim origShape As Shape
Dim origAnchor As Range
' regroup shapes back
For nCounter = 1 To totalGroups Step 1
Set myshape = shapeArray(nCounter)
' select the same Anchor as the original shape was linked to
Set origAnchor = origAnchorArray(nCounter)
origAnchor.Paragraphs(1).Range.Select
Set regroupedShape = myshape.Regroup
regroupedShape.Select
Set origShape = origShapeArray(nCounter)
'Copy most of the original properties back
Selection.ShapeRange.Fill.Transparency = origShape.Fill.Transparency
Selection.ShapeRange.Line.Style = origShape.Line.Style
Selection.ShapeRange.Line.Transparency = origShape.Line.Transparency
Selection.ShapeRange.Line.BackColor.RGB = origShape.Line.BackColor.RGB
Selection.ShapeRange.LockAspectRatio = origShape.LockAspectRatio
Selection.ShapeRange.Height = origShape.Height
Selection.ShapeRange.Width = origShape.Width
Selection.ShapeRange.RelativeHorizontalPosition = origShape.RelativeHorizontalPosition
Selection.ShapeRange.RelativeVerticalPosition = origShape.RelativeVerticalPosition
Selection.ShapeRange.Left = origShape.Left
Selection.ShapeRange.Top = origShape.Top
Selection.ShapeRange.LockAnchor = origShape.LockAnchor
Selection.ShapeRange.WrapFormat.AllowOverlap = origShape.WrapFormat.AllowOverlap
Selection.ShapeRange.WrapFormat.Side = origShape.WrapFormat.Side
Selection.ShapeRange.WrapFormat.DistanceTop = origShape.WrapFormat.DistanceTop
Selection.ShapeRange.WrapFormat.DistanceBottom = origShape.WrapFormat.DistanceBottom
Selection.ShapeRange.WrapFormat.DistanceLeft = origShape.WrapFormat.DistanceLeft
Selection.ShapeRange.WrapFormat.DistanceRight = origShape.WrapFormat.DistanceRight
Selection.ShapeRange.WrapFormat.Type = origShape.WrapFormat.Type
origShape.Delete
Next nCounter
End Sub
I found you could add captions to an autoshape (grouped or otherwise) if you create the autoshape in another word document (you don't need to save it), then Copy/Paste Special it as a picture instead of autoshape. However, it was still a bit glitchy (created a visible text box around the caption instead of doing a tidy caption like it did for other types of figures).
How many of your figures are autoshapes and how many are other formats? If there are only a few that are autoshapes, it might be worth playing with the captioning because it works well for the figure types on the preset list. However, if they are almost all autoshapes, it may be more trouble than it's worth.
If you want more details on the autonumbering through captions, let me know. Also, I only played with this for a few minutes so it may be possible to get it working more smoothly with autoshapes as well.