在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

您似乎正在对单个形状进行分组。这样做的效果是将目标形状包裹在一个外部形状中。这个外部形状(组形状)在默认情况下没有任何几何形状，这解释了为什么设置填充单元没有明显的效果。文本将是可见的，但是，你是对组形状做的，而不是你最初选择的形状。

所以假设分组是有意的你可以这样处理子形状:

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