Vba 如何在Visio绘图中查找所有形状并将每个形状添加到阵列?
我是VBA新手,这是我的第一个任务,涉及到一个预先存在的Visio绘图 Visio绘图由几个形状组成,我最终想要一种使用vba代码检测哪些形状是电缆(两个由动态连接器连接的“连接器”形状)的方法。为此,, 1) 首先,我想将所有形状名称存储在一个数组中。 2) 然后,我想用已知的连接器形状名称交叉检查该数组,并创建一个仅包含这些连接器形状的新数组。 3) 接下来,我将检查每个连接器形状连接到什么,这将允许我确定它是什么类型的电缆(我已经完成了这部分代码)。 4) 最后,我将把电缆的#分配给一个连接器形状(我想我也有这方面的工作代码) 我试图找出如何用现有代码实现步骤1和步骤2 目前,我只能在选择其中一个形状时检测连接的形状:Vba 如何在Visio绘图中查找所有形状并将每个形状添加到阵列?,vba,visio,Vba,Visio,我是VBA新手,这是我的第一个任务,涉及到一个预先存在的Visio绘图 Visio绘图由几个形状组成,我最终想要一种使用vba代码检测哪些形状是电缆(两个由动态连接器连接的“连接器”形状)的方法。为此,, 1) 首先,我想将所有形状名称存储在一个数组中。 2) 然后,我想用已知的连接器形状名称交叉检查该数组,并创建一个仅包含这些连接器形状的新数组。 3) 接下来,我将检查每个连接器形状连接到什么,这将允许我确定它是什么类型的电缆(我已经完成了这部分代码)。 4) 最后,我将把电缆的#分配给一个连
Public Sub ConnectedShapes()
' Get the shapes that are at the other end of
' incoming connections to a selected shape
Dim vsoShape As Visio.Shape
Dim allShapes As Visio.Shapes
Dim lngShapeIDs() As Long
Dim intCount As Integer
If ActiveWindow.Selection.Count = 0 Then
MsgBox ("Please select a shape that has connections.")
Exit Sub
Else
Set vsoShape = ActiveWindow.Selection(1)
End If
Set allShapes = ActiveDocument.Pages.Item(1).Shapes
lngShapeIDs = vsoShape.ConnectedShapes(visConnectedShapesAllNodes, "")
Debug.Print " Shape selected: ";
Debug.Print vsoShape
Debug.Print " Shape(s) connected: ";
For intCount = 0 To UBound(lngShapeIDs)
connectedItem = allShapes.ItemFromID(lngShapeIDs(intCount)).Name
Debug.Print connectedItem
If InStr(1, vsoShape, "USB A - top") = 1 Then
If InStr(1, connectedItem, "USB A Female") = 1 Then
' write cable's number
ElseIf InStr(1, connectedItem, "USB Mini B") = 1 Then
' write cable's number
ElseIf InStr(1, connectedItem, "USB Micro B") = 1 Then
' write cable's number
ElseIf InStr(1, connectedItem, "USB C Male") = 1 Then
' write cable's number
End If
End If
Next
End Sub
是否有Visio vba的内置功能可以帮助我实施步骤1和2?找到文档中的所有形状并将其存储在数组中的最简单方法是什么?了解所需的业务逻辑是第一步。您的步骤1和2可以是单个步骤 理解您的解决方案空间就是理解编程语言提供给您的工具范围。在这种情况下,它是关于如何有效地循环(例如,每个)和信息容器(例如,
集合
)
下面是一些示例代码:
Option Explicit ' Always use this at the top of a module. Always.
Function ExampleFindShapes(chosenPage as Page) as Collection
Dim foundShapes as New Collection ' Note the new part, this initialised the Collection
Dim shapeLoopIterator as Shape
Dim arrayLoopIterator as Long
Dim validShapes as Variant
validShapes = Array("Bob", "Harry", "George")
For each shapeLoopIterator in chosenPage.Shapes ' One way to loop through an object collection
For arrayLoopIterator = LBound(validShapes) to UBound(validShapes) ' One way to loop through an array
If shapeLoopIterator.Name = validShapes(arrayLoopIterator) Then
foundShapes.Add shapeLoopIterator ' store the found shape as a reference to the shape
'Could put something in here to break out of the loop
End If
Next arrayLoopIterator
Next shapeLoopIterator
ExampleFindShapes = foundShapes
End Function
从内存编码,因为我没有在这台机器上安装Visio,所以Page
可能是其他东西
我存储了对形状的引用,而不仅仅是名称,因为在第3部分和第4部分中,找到的形状集合将更易于使用,而不必再次查找和引用形状
如果使用分组的形状,答案会变得更复杂一些。如果是这样的话,我建议一个新问题引用这个问题,因为答案将涉及递归,并将集合传递到更复杂的行