Microsoft Visio'da benzer tüm şekilleri seçin

Bir diyagramdaki tüm benzer şekilleri nasıl seçerim? Örneğin, tüm okları veya tüm dikdörtgenleri nasıl seçerim?

Bunu, oklar veya dikdörtgenlerin sadece çizilmek yerine bir şablon kullanarak oluşturulduğunu varsayarak VBA'da yapabilirsiniz. Bu kod, seçilen sayfadaki gibi aktif sayfadaki tüm şekilleri seçer (şekiller masterini kullanarak)

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

Ayrıca, örneğin dikdörtgen olup olmadıklarını görmek için şekiller için geometri bölümlerine bakmakla uğraşabilirsiniz:

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

Umarım en azından başlamana yardımcı olur ...