VBA Change the Color of a Rounded Rectangle in Visio

Question

I am adding rounded rectangles to a page in Visio using the following code...

        Dim t As Visio.Master
        Set t = Application.Documents.Item("BASIC_U.VSS").Masters.ItemU("Rounded rectangle")

        Application.ActiveWindow.Page.Drop t, 0, 0

        ActiveWindow.DeselectAll
        ActiveWindow.Select Application.ActiveWindow.Page.Shapes.ItemU("Rounded rectangle"), visSelect
        ActiveWindow.Selection.Group

        Dim vsoShps As Visio.Shapes

        Set vsoShps = pg.Shapes
        Dim totalShapes As Integer
        totalShapes = vsoShps.count

        Set vsoShape1 = vsoShps.Item(totalShapes)

        ' move the shapes to random positions
        Application.ActiveWindow.Selection.Move x + 1 / 2 * (lowRight_X_SysShapeCoord - upLeft_X_SysShapeCoord), y + 1 / 2 * (upLeft_Y_SysShapeCoord - lowRight_Y_SysShapeCoord)

        vsoShape1.Cells("Char.Size").Formula = getFontSize(1)

        vsoShape1.Cells("Width") = lowRight_X_SysShapeCoord - upLeft_X_SysShapeCoord
        vsoShape1.Cells("Height") = upLeft_Y_SysShapeCoord - lowRight_Y_SysShapeCoord

        vsoShape1.Text = xlWsh.Range("A" & r)


        ' place text at top center of box
        vsoShape1.CellsU("TxtHeight").FormulaForceU = "Height / 2"


        Dim shp As Visio.Shape
        Set shp = ActiveWindow.Page.Shapes.ItemU("Rounded rectangle")

        ActiveWindow.DeselectAll
        ActiveWindow.Select shp, visSelect

        Dim shpGrp As Visio.Shape
        Set shpGrp = ActiveWindow.Selection.Group

        'Set fill on child shape
        shpGrp.Shapes(1).CellsU("Fillforegnd").FormulaU = "RGB(18, 247, 41)"

Note: there are 5 buttons placed prior to the rectangle

I am able set the text and other text properties but I cannot figure out how to change the fill color of the rounded rectangle. I know how to change the fill color of a regular rectangle...

Set vsoShape1 = ActivePage.DrawRectangle(upLeft_X_SysShapeCoord, _
                                         upLeft_Y_SysShapeCoord, _
                                         lowRight_X_SysShapeCoord, _
                                         lowRight_Y_SysShapeCoord)

' change color
vsoShape1.Cells("Fillforegnd").Formula = "RGB(18, 247, 41)"

But this will not work for the rounded rectangle. I have been searching for hours trying to find a solution but I cannot find the answer. Can someone help?

Solution

Grouping...

        Application.ActiveWindow.Page.Drop Application.Documents.Item("BASIC_U.VSS").Masters.ItemU("Rounded rectangle"), 0, 0

        Dim vsoShps As Visio.Shapes

        Set vsoShps = pg.Shapes
        Dim totalShapes As Integer
        totalShapes = vsoShps.count

        Set vsoShape1 = vsoShps.Item(totalShapes)  

        Dim shp As Visio.Shape
        Set shp = ActiveWindow.Page.Shapes.ItemU("Rounded rectangle")

        ActiveWindow.DeselectAll
        ActiveWindow.Select shp, visSelect

        Dim shpGrp As Visio.Shape
        Set shpGrp = ActiveWindow.Selection.Group

        'Set fill on child shape
        shpGrp.Shapes(1).CellsU("Fillforegnd").FormulaU = "RGB(18, 247, 41)"

Single Shape...

        Application.ActiveWindow.Page.Drop Application.Documents.Item("BASIC_U.VSS").Masters.ItemU("Rounded rectangle"), 0, 0

        Dim vsoShps As Visio.Shapes

        Set vsoShps = pg.Shapes
        Dim totalShapes As Integer
        totalShapes = vsoShps.count

        Set vsoShape1 = vsoShps.Item(totalShapes) 

        vsoShape1.CellsU("Fillforegnd").FormulaU = "RGB(18, 247, 41)"

The top code works when the lines " ActiveWindow.DeselectAll ActiveWindow.Select Application.ActiveWindow.Page.Shapes.ItemU("Rounded rectangle"), visSelect ActiveWindow.Selection.Group" are removed. — user1951756, Sep 08 '15 at 17:41

score 1 · Accepted Answer · answered Sep 08 '15 at 14:13

You appear to be grouping a single shape. This has the effect of wrapping your target shape/s in an outer shape. This outer shape (the group shape) doesn't have any Geometry by default and this explains why setting the fill cell has no visible effect. The text will be visible, but again, you're doing this to the group shape, not the shape you originally selected.

So assuming that the grouping is intentional you can address the child shape like this:

Dim shp As Visio.Shape
Set shp = ActiveWindow.Page.Shapes.ItemU("Rounded rectangle")
'or
'Set shp = ActiveWindow.Selection.PrimaryItem
'or
'Set shp = ActivePage.Shapes(1)

ActiveWindow.DeselectAll
ActiveWindow.Select shp, visSelect

Dim shpGrp As Visio.Shape
Set shpGrp = ActiveWindow.Selection.Group

'Set fill on child shape
shpGrp.Shapes(1).CellsU("Fillforegnd").FormulaU = "RGB(18, 247, 41)"

'or, since you still have a reference to the child
'shp.CellsU("Fillforegnd").FormulaU = "RGB(18, 247, 41)"

I get a run time error "Object not found" for the line "Set shp = ActiveWindow.Page.Shapes.ItemU("Rounded rectangle")". I've edited the answer to show the code. — user1951756, Sep 08 '15 at 17:24
Okay, it works now, I just had to comment my lines "ActiveWindow.DeselectAll ActiveWindow.Select Application.ActiveWindow.Page.Shapes.ItemU("Rounded rectangle"), visSelect ActiveWindow.Selection.Group". I thought these were required to select the shape to move but I think the shape is already "selected" after it is created (I think). Thanks! — user1951756, Sep 08 '15 at 17:35

VBA Change the Color of a Rounded Rectangle in Visio

1 Answers1

Linked