VBA 在 Visio 中更改圆角矩形的颜色

Question

我正在使用以下代码在 Visio 中的页面中添加圆角矩形...

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

注意：在矩形之前放置了 5 个按钮

我可以设置文本和其他文本属性，但我不知道如何更改圆角矩形的填充颜色。我知道如何更改常规矩形的填充颜色...

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

但这不适用于圆角矩形。我一直在寻找几个小时试图找到解决方案，但我找不到答案。有人可以帮忙吗？

解决方案

分组...

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

单一形状...

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

Answer 1

您似乎在对一个形状进行分组。这具有将目标 shape/s 包裹在外部形状中的效果。默认情况下，此外部形状（组形状）没有任何几何形状，这解释了为什么设置填充单元格没有可见效果。文本将可见，但同样，您是对组形状执行此操作，而不是您最初选择的形状。

因此假设分组是有意的，您可以像这样处理子形状：

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

VBA 在 Visio 中更改圆角矩形的颜色

VBA Change the Color of a Rounded Rectangle in Visio

vba

visio