Changing Shape Color in Visio

Question

Need some help!

I'm relatively knowledgeable when it comes to macros, VBA, scripts, etc., but Visio coding is an all new monster to me.

In short, I have a warehouse map layout with simple square shapes marking product locations, and I want to color-code the squares based on their Prop._VisDM_F2 data element. My code so far seems to work, but only for the 1st shape in the group of squares, but sometimes the master shape consists of 1 square, sometimes 6, and everything in between.

I've learned that the # in "Shapes( # )" selects which square gets changed, but I want them ALL to change. I've tried to get a count of how many individual shapes are in each master shape to use a variable integer as the # , but it didn't work.

Surely such a simple task can't really this complicated so I'm probably just missing something a step. Any help would be greatly appreciated!

'''

Dim selectObj As Visio.Shape

For Each selectObj In ActiveWindow.Selection
If selectObj.CellExistsU("Prop._VisDM_F2", Visio.VisExistsFlags.visExistsAnywhere) Then
selectObj.Shapes(1).Cells("Fillforegnd").FormulaU = visWhite
End If
Next

End Sub

'''

Answer 1

Shapes can have sub-shapes which are accessed through the Shapes property as per your code (note that most Visio collections are 1 rather than 0 based).

You can address the sub-shapes collection either by index or with a further for each. So given that you may or may not know the depth of your sub-shapes you can recurse through them something like this:

Sub ApplyFillToAll()

Dim shp As Visio.Shape

For Each shp In ActiveWindow.Selection
    If shp.CellExistsU("Prop._VisDM_F2", Visio.VisExistsFlags.visExistsAnywhere) Then
        SetFill shp, "RGB(255,0,0)"
    End If
Next

End Sub

Public Sub SetFill(ByRef shpIn As Visio.Shape, fillFormula As String)

Dim shp As Visio.Shape

For Each shp In shpIn.Shapes
    shp.Cells("FillForegnd").FormulaU = fillFormula
    SetFill shp, fillFormula
Next

End Sub

Note that the formula that you're setting is a string and so is wrapped in double quotes, and the above will set all of the sub-shapes to red with the SetFill method calling itself to navigate down through the tree.

I'll add a link to a very old post that you might also find useful:

https://visualsignals.typepad.co.uk/vislog/2007/11/looping-through.html