在 Microsoft Visio 中选择所有相似的形状

在 Microsoft Visio 中选择所有相似的形状

如何选择图表中的所有相似形状?例如,如何选择所有箭头或所有矩形?

答案1

您可以在 VBA 中执行此操作,假设箭头或矩形是使用模板创建的,而不是直接绘制的。此代码将选择活动页面中的所有形状,如所选形状(使用形状主控)

Sub SelectSimilarShapesByMaster()
    If ActiveWindow.Selection.Count = 0 Then Exit Sub

    Dim SelShp As Visio.Shape
    Set SelShp = ActiveWindow.Selection(1)

    If SelShp.Master Is Nothing Then Exit Sub
    ActiveWindow.DeselectAll
    Dim CheckShp As Visio.Shape
    For Each CheckShp In ActivePage.Shapes
        If Not CheckShp.Master Is Nothing Then
            If CheckShp.Master = SelShp.Master Then
                ActiveWindow.Select CheckShp, visSelect
            End If
        End If
    Next CheckShp

End Sub

您还可以查看形状表几何部分中的形状以查看它们是否是矩形,如下所示:

Sub SelectRectangles()
    If ActiveWindow.Selection.Count = 0 Then Exit Sub

    Dim SelShp As Visio.Shape
    Set SelShp = ActiveWindow.Selection(1)

    ActiveWindow.DeselectAll
    Dim CheckShp As Visio.Shape
    For Each CheckShp In ActivePage.Shapes
        If IsRectangle(CheckShp) Then ActiveWindow.Select CheckShp, visSelect
    Next CheckShp

End Sub

Function IsRectangle(TheShape As Visio.Shape) As Boolean
    Dim Width As Double, Height As Double
    Width = TheShape.CellsU("Width")
    Height = TheShape.CellsU("Height")
    Dim Result As Boolean
    Result = (TheShape.RowCount(visSectionFirstComponent) = 6)
    Result = (Result And TheShape.CellsSRC(visSectionFirstComponent, 1, 0).ResultIU() = 0 And TheShape.CellsSRC(visSectionFirstComponent, 1, 1).ResultIU() = 0)
    Result = (Result And TheShape.CellsSRC(visSectionFirstComponent, 2, 0).ResultIU() = Width And TheShape.CellsSRC(visSectionFirstComponent, 2, 1).ResultIU() = 0)
    Result = (Result And TheShape.CellsSRC(visSectionFirstComponent, 3, 0).ResultIU() = Width And TheShape.CellsSRC(visSectionFirstComponent, 3, 1).ResultIU() = Height)
    Result = (Result And TheShape.CellsSRC(visSectionFirstComponent, 4, 0).ResultIU() = 0 And TheShape.CellsSRC(visSectionFirstComponent, 4, 1).ResultIU() = Height)
    Result = (Result And TheShape.CellsSRC(visSectionFirstComponent, 5, 0).ResultIU() = 0 And TheShape.CellsSRC(visSectionFirstComponent, 5, 1).ResultIU() = 0)
    IsRectangle = Result
End Function

希望这至少能帮助你开始……

相关内容