troubleshooting Question

Autonumbering of figures in Word

Avatar of henk53
henk53 asked on
Microsoft Office
6 Comments1 Solution669 ViewsLast Modified:
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
ASKER CERTIFIED SOLUTION
Computer101

Our community of experts have been thoroughly vetted for their expertise and industry experience.

Join our community to see this answer!
Unlock 1 Answer and 6 Comments.
Start Free Trial
Learn from the best

Network and collaborate with thousands of CTOs, CISOs, and IT Pros rooting for you and your success.

Andrew Hancock - VMware vExpert
See if this solution works for you by signing up for a 7 day free trial.
Unlock 1 Answer and 6 Comments.
Try for 7 days

”The time we save is the biggest benefit of E-E to our team. What could take multiple guys 2 hours or more each to find is accessed in around 15 minutes on Experts Exchange.

-Mike Kapnisakis, Warner Bros