SmartShapeRenumber

A Free Document Productivity Tool For Visio

SmartShapeRenumber allows you to renumber group shapes where the number of the shape is in a separate location from the shapes text.

In this example it will enter the number of the shape in the top right portion of the main shape. 

SmartShapeRenumber also supports numbering simple shapes where the number is part of the text of the main shape.

SmartShapeRenumber also supports prefix values if you need them.

Visio's standard renumbering tool supports the prefix concept but only applies numbers to the main text of the shape and will not put number a group shape. 

Using the Tool

Select the shapes to number one at a time holding the control key down and clicking the shapes in the order that they are to be numbered.  
Press the SmartShapeRenumber shortcut key (control+N).

The first time SmartShapeRenumber is used, you can add a prefix that will apply to all numbered shapes on the current page.  


Leave this blank if you dont have a prefix.

You now enter the value to start numbering from. 
SmartShapeRenumber finds the number of the first shape as a default, so if you are renumbering, start with the first unchanged shape.




The shapes in the selection are renumbered in the order that they were selected.

How it works

SmartShapeRenumber looks for the subshape that contains the numbering portion.  It does this by locating the subshape that contains just a number or the "*" charter (a placeholder for a number).  In addition it will also look for any subshape that has already been numbered but the tool.  


If there is no subshape that meets these criteria, the shape itself is used.


SmartShapeRenumber knows if a subshape has been renumbered already by adding some properties to the shapesheet to record the prefix and current value. This is the same way that Visio's standard tool works.


You can change the page prefix by entering 999 in the renumbering screen or changing the page's shapesheet values.

Update July 1

I found a bug in the original routine published. It has now been fixed and recorded in the download file

Inspiration

I use this tool when numbering process model shapes where the shape template. Without it renumber large process models using these shapes is very time consuming.

Quick Routine

Here is a cut down version of the tool if you want to see how this tool started out.

Private Sub dpSimpleRenumberGroupShapes()

    Dim vsoSelect As Visio.Selection
    Dim vsoShape As Visio.Shape
    Dim vsoCntrShape As Visio.Shape
    Dim sCntr As String
    Dim iCntr As Integer


    'check that at least one shape is selected
    Set vsoSelect = Visio.ActiveWindow.Selection
    
    If vsoSelect.Count = 0 Then
        MsgBox "You Must Selected one or more shapes to renumber"
        Exit Sub
    End If

    iCntr = 0
    For Each vsoShape In vsoSelect
        'for each selected shape return the shape itself or the subshape containing the counter
        Set vsoCntrShape = wrkGetCounterShape(vsoShape)
        If iCntr = 0 Then 'first shape found
            iCntr = wrkGetCounterValue(vsoCntrShape)
            sCntr = InputBox("Number to assign to first selected shape", "", iCntr)
            'Exit the routine if the user does not enter a counter value
            If IsNumeric(sCntr) = True Then
                iCntr = sCntr
            Else
                Exit Sub ' exit if the user cancelled from the get counter input box
            End If
        End If
        'Assign the number to the shape text
        vsoCntrShape.Text = iCntr
        iCntr = iCntr + 1
    Next vsoShape
End Sub
Function wrkGetCounterShape(vsoShape As Shape) As Shape

    Dim vsoSubShape As Visio.Shape
    Dim vsoCell As Visio.Cell
    
    'the default shape returned is the inbound shape - if not group shape this wont change
    Set wrkGetCounterShape = vsoShape
    For Each vsoSubShape In vsoShape.Shapes
        'Detect the subshape 'has a * or is just a number or has a shape sheet value indicating previous renumber
        If Left(vsoSubShape.Text, 1) = "*" _
           Or IsNumeric(vsoSubShape.Text) = True Then
            Set wrkGetCounterShape = vsoSubShape
            Exit For
        End If
    Next vsoSubShape
   
End Function

Function wrkGetCounterValue(vsoShape As Shape) As Integer
    wrkGetCounterValue = 1
    If IsNumeric(vsoShape.Text) Then wrkGetCounterValue = vsoShape.Text
End Function