Kindly request macro to auto-number all shapes that belong to a specific layer

[rsrikanth83]

Kindly request macro to auto-number all shapes that belong to a specific layer.

Also flexibility in the starting number, interval and prefix will help.

[TwoBeAss]

Code Select Expand

Sub AutoNumberShapesOnLayer()
    Dim layerName As String
    Dim startNumber As Integer
    Dim interval As Integer
    Dim prefix As String
    Dim shp As Visio.Shape
    Dim currentNumber As Integer
   
    ' Customize these variables
    layerName = "YourLayerName"  ' Replace with the name of your layer
    startNumber = 1              ' Starting number for the numbering
    interval = 1                 ' Interval between numbers
    prefix = "Shape-"            ' Prefix for the numbering
   
    ' Initialize the current number
    currentNumber = startNumber
   
    ' Loop through each shape on the page
    For Each shp In ActivePage.Shapes
        ' Check if the shape is part of the specified layer
        If shp.LayerCount > 0 Then
            Dim i As Integer
            For i = 1 To shp.LayerCount
                If shp.Layer(i).Name = layerName Then
                    ' Apply the numbering
                    shp.Text = prefix & currentNumber
                    ' Update the current number for the next shape
                    currentNumber = currentNumber + interval
                    Exit For
                End If
            Next i
        End If
    Next shp
   
    MsgBox "Auto-numbering complete for layer: " & layerName, vbInformation
End Sub


[rsrikanth83]

Thank you for the macro. This is helpful.


To be closer to the standard Visio way of auto-numbering, is it possible to update the macro code to simulate the below navigation:

View menu -> Add ons -> Visio Extras -> Number Shapes.

On accessing the above, we are able to add the Start with, Interval, Preceding text with Operation as "Auto number" and Apply to "Selected shapes"

When we do the above action, Visio automatically creates 3 shape data columns Shape Number, Shape Number Text and Hide Shape Number, corresponding to the standard fields available ShapeNumber, ShapeNumberText and HideShapeNumber.

Then Visio updates the shape number accordingly and the prefix in the Shape Number Text column.

The Hide Shape Number default value can be TRUE.

Kindly let me know if you will be able to incorporate the above? Please let me know if you need any further information.

Thank you!

[rsrikanth83]

Code Select Expand

Sub AssignShapeDataWithNumberingToSelectedShapes()
    Dim shp As Visio.Shape
    Dim shapeNumber As Long
    Dim shapeNumberText As String
    Dim hideShapeNumber As Boolean
    Dim incrementValue As Long
    Dim selection As Visio.Selection
   
    ' Initialize starting values
    shapeNumber = 10
    shapeNumberText = "TEST-"
    hideShapeNumber = True
    incrementValue = 10
   
    ' Get the current selection
    Set selection = ActiveWindow.Selection
   
    ' Loop through each selected shape
    For Each shp In selection
        ' Check if the shape can have shape data
        If shp.OneD = 0 Then
            ' Add Shape Data (Custom Properties)
            AddShapeData shp, "ShapeNumber", shapeNumber, "Shape Number"
            AddShapeData shp, "ShapeNumberText", shapeNumberText, "Shape Number Text"
            AddShapeData shp, "HideShapeNumber", CStr(hideShapeNumber), "Hide Shape Number"
           
            ' Increment the shapeNumber by the defined value
            shapeNumber = shapeNumber + incrementValue
        End If
    Next shp
End Sub

Sub AddShapeData(shp As Visio.Shape, propName As String, propValue As Variant, propLabel As String)
    ' Check if the property already exists, if not, add it
    If Not shp.CellExistsU("Prop." & propName, Visio.VisExistsFlags.visExistsAnywhere) Then
        shp.AddNamedRow visSectionProp, propName, visRowProp
    End If
   
    ' Assign the value to the property without quotes
    shp.CellsU("Prop." & propName).FormulaU = propValue
   
    ' Set the label for the property
    shp.CellsU("Prop." & propName & ".Label").FormulaU = """" & propLabel & """"
   
    ' Optional: Set the type of the shape data (0=String, 1=Fixed list, 2=Number, 3=Boolean, 4=Variable list, 5=Date or time)
    ' Set as general format by avoiding setting the type as number
    If propName = "ShapeNumber" Then
        shp.CellsU("Prop." & propName & ".Type").FormulaU = "0" ' General (default) format
    Else
        Select Case propName
            Case "ShapeNumberText"
                shp.CellsU("Prop." & propName & ".Type").FormulaU = "0" ' String
            Case "HideShapeNumber"
                shp.CellsU("Prop." & propName & ".Type").FormulaU = "3" ' Boolean
        End Select
    End If
End Sub


[rsrikanth83]

Though not specific to a layer, below macro code does auto-numbering for selected shapes. Please let me know if you find this to be useful.

Code Select Expand

Sub AssignShapeDataWithNumberingToSelectedShapes()
    Dim shp As Visio.Shape
    Dim shapeNumber As Long
    Dim shapeNumberText As String
    Dim hideShapeNumber As Boolean
    Dim incrementValue As Long
    Dim selection As Visio.Selection
   
    ' Initialize starting values
    shapeNumber = 10
    shapeNumberText = "TEST-"
    hideShapeNumber = True
    incrementValue = 10
   
    ' Get the current selection
    Set selection = ActiveWindow.Selection
   
    ' Loop through each selected shape
    For Each shp In selection
        ' Check if the shape can have shape data
        If shp.OneD = 0 Then
            ' Add Shape Data (Custom Properties)
            AddShapeData shp, "ShapeNumber", shapeNumber, "Shape Number"
            AddShapeData shp, "ShapeNumberText", shapeNumberText, "Shape Number Text"
            AddShapeData shp, "HideShapeNumber", CStr(hideShapeNumber), "Hide Shape Number"
           
            ' Increment the shapeNumber by the defined value
            shapeNumber = shapeNumber + incrementValue
        End If
    Next shp
End Sub

Sub AddShapeData(shp As Visio.Shape, propName As String, propValue As Variant, propLabel As String)
    ' Check if the property already exists, if not, add it
    If Not shp.CellExistsU("Prop." & propName, Visio.VisExistsFlags.visExistsAnywhere) Then
        shp.AddNamedRow visSectionProp, propName, visRowProp
    End If
   
    ' Assign the value to the property without quotes
    shp.CellsU("Prop." & propName).FormulaU = propValue
   
    ' Set the label for the property
    shp.CellsU("Prop." & propName & ".Label").FormulaU = """" & propLabel & """"
   
    ' Optional: Set the type of the shape data (0=String, 1=Fixed list, 2=Number, 3=Boolean, 4=Variable list, 5=Date or time)
    ' Set as general format by avoiding setting the type as number
    If propName = "ShapeNumber" Then
        shp.CellsU("Prop." & propName & ".Type").FormulaU = "0" ' General (default) format
    Else
        Select Case propName
            Case "ShapeNumberText"
                shp.CellsU("Prop." & propName & ".Type").FormulaU = "0" ' String
            Case "HideShapeNumber"
                shp.CellsU("Prop." & propName & ".Type").FormulaU = "3" ' Boolean
        End Select
    End If
End Sub