А это не такой-то простой макрос... Да еще похоже, что в конкретном случае может влиять какая-нибудь специфика.
Кстати, запускать макросы лучше не по клику, а по двойному клику. Для этого специальная ячейка есть в шейп-листе.
Вот для примера макрос, решающий похожую задачу (только с ручным запуском).
На листе есть много квадратиков, соединенных коннекторами. Если выделить один квадратик и запустить макрос bounce, то селектируются все связанные квадратики. Коннекторы не селектировались.
Используется рекурсивный вызов процедуры recurs. Имена набиваются в коллекцию, потом все селектируется.
Dim Scol As Collection
Sub bounce()
Dim shTmp As Visio.Shape 'временный
Set shTmp = ActiveWindow.Selection(1)
Set Scol = New Collection
Scol.Add shTmp.NameID
recurs shTmp
ActiveWindow.DeselectAll
For i = 1 To Scol.Count
ActiveWindow.Select ActivePage.Shapes(Scol(i)), visSelect
Next
End Sub
Sub recurs(Sh As Visio.Shape)
Dim shTmp As Visio.Shape 'временный
Dim sc As Visio.Shape 'коннектор
For i = 1 To Sh.FromConnects.Count
Set sc = Sh.FromConnects(i).FromSheet
If sc.Connects.Count > 1 Then
If sc.Connects(1).ToSheet = Sh Then
Flag = 0
For Each stmp In Scol
If StrComp(stmp, sc.Connects(2).ToSheet.NameID) = 0 Then Flag = 1
Next
If Flag = 0 Then
Scol.Add (sc.Connects(2).ToSheet.NameID)
Set shTmp = sc.Connects(2).ToSheet
recurs shTmp
End If
Else
Flag = 0
For Each stmp In Scol
If StrComp(stmp, sc.Connects(1).ToSheet.NameID) = 0 Then Flag = 1
Next
If Flag = 0 Then
Scol.Add (sc.Connects(1).ToSheet.NameID)
Set shTmp = sc.Connects(1).ToSheet
recurs shTmp
End If
End If
End If
Next
End Sub
All Forums
Подскажите пример макроса
Posted - 12/20/2008 : 14:06:52
