☰

FAQ по автоматизации Visio: VBA, шейпы и события

Ответы на вопросы по автоматизации Microsoft Visio: как через VBA собрать данные со всех шейпов, прочитать свойства, отловить изменение геометрии и списки.

Как программно (VBA) собрать данные со всех шейпов на странице?

Для сбора данных по всем шейпам на странице используется коллекция 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

Как программно добраться до свойств шейпа (Properties)?

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

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


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

Как отловить изменение геометрии шейпа?

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

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

Динамическое формирование списка выбора (Fixed List)

Для создания выпадающего списка на основе данных из БД нужно установить тип поля в Fixed List и программно заполнить ячейку Format строкой значений, разделенных точкой с запятой.

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

Как сделать страницу активной программно?

appObj.ActiveWindow.Page = "Page-1"

Связь с базой данных Access через ADODB


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

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

↑