CODEWITHSUNDEEP
vbavisio
user1951756
user1951756

Reputation: 511

VBA Change the Color of a Rounded Rectangle in Visio

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)"

Upvotes: 1

Views: 7739

Answers (1)

JohnGoldsmith
JohnGoldsmith

Reputation: 2698

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)"

Upvotes: 1

Related Questions