VBA在Visio中更改圆角矩形的颜色(VBA Change the Color of a Rounded Rectangle in Visio)
我正在使用以下代码将圆角矩形添加到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)"I am adding rounded rectangles to a page in Visio using the following code...
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)"Note: there are 5 buttons placed prior to the rectangle
I am able set the text and other text properties but I cannot figure out how to change the fill color of the rounded rectangle. I know how to change the fill color of a regular rectangle...
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)"But this will not work for the rounded rectangle. I have been searching for hours trying to find a solution but I cannot find the answer. Can someone help?
Solution
Grouping...
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 Shape...
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)"最满意答案
您似乎将一个形状分组。 这具有将目标形状包裹在外部形状中的效果。 这种外部形状（组形状）默认情况下不具有任何几何图形，这就解释了为什么设置填充单元没有可见效果。 文本将是可见的，但同样，您要对组形状执行此操作，而不是最初选择的形状。
所以假设这个分组是有意的，你可以像这样解决孩子的问题：
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)"You appear to be grouping a single shape. This has the effect of wrapping your target shape/s in an outer shape. This outer shape (the group shape) doesn't have any Geometry by default and this explains why setting the fill cell has no visible effect. The text will be visible, but again, you're doing this to the group shape, not the shape you originally selected.
So assuming that the grouping is intentional you can address the child shape like this:
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)"更多推荐
发布评论