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