Vba 如何在visio中遍历某些形状？

我想在Visio中迭代一些形状，我有一个可行的解决方案，但有点低，因为有很多形状（可能有一千个，我只对其中的二十个或三十个感兴趣）：

是否可以在列表中添加一些形状，而不是选择所有现有形状？ 诸如此类：

For Each shp In List 

提前非常感谢：）

编辑：我是这样做的：

声明和集合部分：

Public Collection_shp As Collection
Set Collection_shp = New Collection

Public Collection_shp As Collection
Set Collection_shp = New Collection

创建标签形状时，我会将其添加到集合中：

Collection_shp.Add Item:=vso_sg

Collection_shp.Add Item:=vso_sg

还有带回路的部分：

Dim shp As Visio.Shape
For Each shp In Collection_shp 

If InStr(shp.Data3, "_tag") > 0 Then
If StrComp(Replace(shp.Data3, "_tag", ""), name) = 0 Then
    shp.text = name
    Else
    shp.text = ""
    End If
    End If
    Next shp

Dim shp As Visio.Shape
For Each shp In Collection_shp 

If InStr(shp.Data3, "_tag") > 0 Then
If StrComp(Replace(shp.Data3, "_tag", ""), name) = 0 Then
    shp.text = name
    Else
    shp.text = ""
    End If
    End If
    Next shp

---

我是这样做的：

声明和集合部分：

Public Collection_shp As Collection
Set Collection_shp = New Collection

Public Collection_shp As Collection
Set Collection_shp = New Collection

创建标签形状时，我会将其添加到集合中：

Collection_shp.Add Item:=vso_sg

Collection_shp.Add Item:=vso_sg

还有带回路的部分：

Dim shp As Visio.Shape
For Each shp In Collection_shp 

If InStr(shp.Data3, "_tag") > 0 Then
If StrComp(Replace(shp.Data3, "_tag", ""), name) = 0 Then
    shp.text = name
    Else
    shp.text = ""
    End If
    End If
    Next shp

Dim shp As Visio.Shape
For Each shp In Collection_shp 

If InStr(shp.Data3, "_tag") > 0 Then
If StrComp(Replace(shp.Data3, "_tag", ""), name) = 0 Then
    shp.text = name
    Else
    shp.text = ""
    End If
    End If
    Next shp

---

指令分隔符标记（

：

）在

Else

之后是多余的，并且误导性是一个可读性问题，需要在它引起问题之前解决。也就是说，您不需要迭代所有形状来确定您感兴趣的形状吗？或者，您可以在

数组中对它们进行硬编码，但是20-30个项对于硬编码来说似乎是相当多的数据。
如果InStr（shp.Data3，“_tag”），那么
也是一个问题-
InStr
返回一个索引，而不是布尔值。这个，别让它咬你！如果您在点击后退出（或者您希望有多个匹配项？）会更快。您需要运行此循环多少次？如果您需要多次运行，您可以加载一个集合，其中包含所有带有
shp.Data3的形状，如“*\u tag”
，然后迭代。很抱歉，我刚刚看到了您的答案（离开办公室，然后睡觉），我将尝试它们，并告诉您：）