Данный код перекрашивает фигуры присоединенные к коннектору в цвет коннектора

no_magic.md

Нижеприведенный код всего около 40 строк, добавляет соединительной линии возможность изменять цвета фигур к ней присоединенных.

Обычному пользователю это кажется фантастикой…
Данная магия достигается с использованием событий объекта Application.

Private WithEvents vsoApplication As Visio.Application  ' переменная связанная с событиями
 Public Sub start() ' процедура запуска режима перекраски
  Set vsoApplication = Application ' определяем переменную связанную с событиями
 End Sub

 Public Sub stop_it() ' процедура остановки режима перекраски
  Set vsoApplication = Nothing  ' освобождаем переменную связанную с событиями
 End Sub

 Private Sub Document_DocumentOpened(ByVal doc As IVDocument) ' автозапуск в режиме перекраски при открытии документа
 start  ' запускаем процедуру Start
 End Sub

 Private Sub vsoApplication_BeforeShapeDelete(ByVal Shape As IVShape) ' процедура события перед удалением коннектора
 Dim m As Master, n As Integer
 Set m = Shape.Master  ' определяем родительский мастер фигуры
 If Not m Is Nothing Then
 	For n = 1 To Shape.Connects.Count  ' перебираем все соединения коннектора
 		Set cs = Shape.Connects.Item(n).ToSheet  ' определяем n-ную присоединенную фигуру
 		cs.Cells("LineColor").Formula = 0 ' перекрашиваем n-ную присоединенную фигуру в черный цвет
 	Next
 End If
 End Sub

 Private Sub vsoApplication_ConnectionsAdded(ByVal Connects As IVConnects) ' процедура события добавления соединения
 Dim connector As Shape, n As Integer, cs As Shape
 For n = 1 To Connects.Count ' перебираем все соединения коннектора
 	Set connector = Connects.FromSheet ' определяем фигуру-коннектор
 	Set cs = Connects.Item(n).ToSheet ' определяем n-ную присоединенную фигуру
 	cs.Cells("LineColor") = connector.Cells("LineColor") ' перекрашиваем n-ную присоединенную фигуру
 Next
 End Sub

 Private Sub vsoApplication_ConnectionsDeleted(ByVal Connects As IVConnects) ' процедура события удаления соединения
 Dim connector As Shape, n As Integer, cs As Shape
  For n = 1 To Connects.Count ' перебираем все соединения коннектора
 	Set connector = Connects.FromSheet ' определяем фигуру-коннектор
 	Set cs = Connects.Item(b).ToSheet ' определяем n-ную присоединенную фигуру
 	cs.Cells("LineColor").Formula = 0 ' перекрашиваем n-ную присоединенную фигуру в черный цвет
 Next
 End Sub