Автоматизация Visio через VBA: примеры макросов и событий

Visio автоматизируют макросами на VBA внутри документа или надстройками на .NET. Ниже собраны рабочие примеры: как пройти по всем фигурам страницы и собрать их данные, добраться до вложенных фигур, отследить изменение геометрии и заполнить список. Общий обзор подходов — в статье про программирование в Visio.

Как собрать данные со всех фигур страницы

Для обхода фигур используется коллекция Shapes объекта Page. Макрос ниже собирает в массив свойства Part Number, Manufacturer и Cost. Эти свойства фигуры заполняются в окне данных фигуры, подробнее об этом — в статье про связь рисунков с данными.

Public Sub ExportShapeData()
  Dim pagObj As Visio.Page
  Dim shpsObj As Visio.Shapes
  Dim shpObj As Visio.Shape
  Dim celObj As Visio.Cell
  Dim OrderInfo() As String
  Dim iShapeCount As Integer
  Dim i As Integer

  Set pagObj = ActivePage
  Set shpsObj = pagObj.Shapes
  iShapeCount = shpsObj.Count

  ReDim OrderInfo(3, iShapeCount - 1)

  For i = 1 To iShapeCount
    Set shpObj = shpsObj(i)
    OrderInfo(0, i - 1) = shpObj.Name

    If shpObj.CellExists("Prop.Part_Number", visExistsLocally) Then
      Set celObj = shpObj.Cells("Prop.Part_Number")
      OrderInfo(1, i - 1) = celObj.ResultStr("")
    End If

    If shpObj.CellExists("Prop.Manufacturer", visExistsLocally) Then
      Set celObj = shpObj.Cells("Prop.Manufacturer")
      OrderInfo(2, i - 1) = celObj.ResultStr("")
    End If

    If shpObj.CellExists("Prop.Cost", visExistsLocally) Then
      Set celObj = shpObj.Cells("Prop.Cost")
      OrderInfo(3, i - 1) = celObj.ResultIU
    End If

    Set shpObj = Nothing
  Next
End Sub

Как получить свойства вложенной фигуры

Если свойства не видны в Cells напрямую, например в фигурах UML, они могут находиться во вложенных фигурах группы. В таком случае нужно обращаться к коллекции Shapes самой группы.

Например, в фигуре Class атрибуты хранятся в шестой вложенной фигуре:

Sub GetAttributes()
  ' Показывает текст из вложенной фигуры Attributes
  MsgBox ActivePage.Shapes(1).Shapes(6).Text
End Sub

Как отследить изменение геометрии фигуры

Для отслеживания изменений геометрии используется ячейка события EventXFMod. Формулу можно задать в ячейке ShapeSheet вручную или из кода:

Shape.Cells("EventXFMod").Formula = "RUNADDON(""ThisDocument.MyMacro"")"

Как динамически заполнить список выбора

Чтобы создать выпадающий список на основе данных из базы, установите для свойства тип Fixed List и программно запишите в ячейку Format строку значений, разделённых точкой с запятой:

Shape.Cells("prop.MyList.Format").Formula = """Value1;Value2;Value3"""

Как сделать страницу активной из кода

appObj.ActiveWindow.Page = "Page-1"

Как связаться с базой Access через ADODB

В примере при добавлении фигуры на страницу открывается база Access и построчно выводятся значения из таблицы:

Private Sub Document_ShapeAdded(ByVal Shape As IVShape)
  Dim cnn As New ADODB.Connection
  cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\temp\db1.mdb;"

  Dim datPrimaryRS As New ADODB.Recordset
  datPrimaryRS.Open "tabl1", cnn, adOpenKeyset, adLockOptimistic, adCmdTable
  datPrimaryRS.MoveFirst

  While Not datPrimaryRS.EOF
    MsgBox datPrimaryRS!название & " " & datPrimaryRS!характеристика
    datPrimaryRS.MoveNext
  Wend

  datPrimaryRS.Close
  cnn.Close
End Sub

Другие разделы

• Совместимость с другими программами
• Прочие вопросы и приёмы
• Опыт разработки решений