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

Single Форма ...

 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

Вы, кажется, группируя единую форму. Это приводит к обертыванию вашей целевой фигуры/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)"