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

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

所以假设分组是故意的，你可以解决孩子的形状是这样的：

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