2

第一次使用 Visio 进行 VBA 编码的用户在这里!

我正在使用 Visio 2010 Pro

我正在尝试使用 VBA 自动绘制系统架构图。数据源是 Excel 工作表。希望是这样的结果……

我已经编写了 VBA 来读取 Excel 表格,并且可以在互联网上的一些帮助下创建页面上的形状(谢谢大家!)

我想要走的路是:

  • 首先为每个系统删除对象
  • 使用自动连接,遍历记录集并绘制系统之间的链接(显示集成)
    • 从 Excel 数据中,链接知道它们正在连接的形状的名称(当我将形状放在页面上时,我会分配 shape.name)。

我不知道如何使用形状名称来识别唯一的形状对象(可以用作自动连接方法的参数)

有没有更好或更简单的方法来做到这一点?

我看过自动连接示例(http://msdn.microsoft.com/en-us/library/office/ms427221%28v=office.12%29.aspx);如果我有一个在运行时创建的对象的句柄(即为每个创建的对象创建一个变量),那么它工作得很好找到对象。

我想对最好的方法提出一些想法。鉴于我是 Visio 新手,一些示例(工作?)代码会很受欢迎。

我对整理特别感兴趣的代码被注释为“连接形状......”

我还有一个小问题;是每次我运行 VBA 时都会创建一个新模板。如果不这样做,我怎么还能选择大师?

非常感谢!

我不确定人们需要多少信息才能了解我想要实现的目标,因此附上了我迄今为止编写/黑客/抄袭的代码

Public Sub DrawSystem()

Dim strConnection As String
Dim strCommand As String
Dim vsoDataRecordset As Visio.DataRecordset

strConnection = "Provider=Microsoft.ACE.OLEDB.12.0;" _
                   & "User ID=Admin;" _
                   & "Data Source=" + "b:\visio\Objects2;" _
                   & "Mode=Read;" _
                   & "Extended Properties=""HDR=YES;IMEX=1;MaxScanRows=0;Excel 12.0;"";" _
                   & "Jet OLEDB:Engine Type=34;"

strCommand = "SELECT * FROM [Sheet1$]"

' load the data ...
Set vsoDataRecordset = ActiveDocument.DataRecordsets.Add(strConnection, strCommand, 0, "Objects")

'Stencil document that contains master
Dim stnObj As Visio.Document
'Master to drop
Dim mastObj As Visio.Master
'Pages collection of document
Dim pagsObj As Visio.Pages
'Page to work in
Dim pagObj, activePageObj As Visio.Page
'Instance of master on page
Dim shpObj As Visio.Shape
Dim shpFrom As Variant
Dim shpTo As Variant

Set stnObj = Documents.Add("Basic Shapes.vss")

' create a new page in the document
Set pagObj = ThisDocument.Pages.Add
pagObj.Name = "Page-" & Pages.Count

' -------------------------------------------------------
' LOOP THROUGH THE RECORDSET
' -------------------------------------------------------
Dim lngRowIDs() As Long
Dim lngRow As Long
Dim lngColumn As Long
Dim varRowData As Variant

' process the ENTITY records
Debug.Print "PROCESSING ENTITY RECORDS"
lngRowIDs = vsoDataRecordset.GetDataRowIDs("")

' draw rectangles for systems
Set mastObj = stnObj.Masters("Rectangle")

'Iterate through all the records in the recordset.
For lngRow = LBound(lngRowIDs) To UBound(lngRowIDs)

    varRowData = vsoDataRecordset.GetRowData(lngRow)

    If varRowData(2) = "ENTITY" Then

        ' draw a new object on the created page with the correct details
        ' TODO - work out how to programmatically draw them in an appropriate location
        Set shpObj = pagObj.Drop(mastObj, lngRow / 2, lngRow / 2)

        ' set the appropriate attributes on the new object from the dataset
        shpObj.Name = varRowData(3)
        shpObj.Text = varRowData(7)
        shpObj.data1 = varRowData(3)
        shpObj.data2 = varRowData(7)
        shpObj.Data3 = varRowData(8)

        shpObj.Cells("Width") = 0.75
        shpObj.Cells("Height") = 0.5

        Debug.Print ("Created Object: " & varRowData(3) & " : ID = " & shpObj.ID)
    Else
        Debug.Print ("SKIPPED:" & varRowData(2) & " : " & varRowData(0))
    End If

Next lngRow

' process the LINK records
Debug.Print "PROCESSING LINK RECORDS"
lngRowIDs = vsoDataRecordset.GetDataRowIDs("")

Set mastObj = stnObj.Masters("Dynamic Connector")

'Iterate through all the records in the recordset.
For lngRow = LBound(lngRowIDs) To UBound(lngRowIDs)

    ' only process LINK records
    If varRowData(2) = "LINK" Then

        Debug.Print ("Joining! " & varRowData(4) & " - " & varRowData(5) & " with " & varRowData(6))

        Set shpObj = pagObj.Drop(mastObj, 2 + lngRow * 3, 0 + lngRow * 3)
        varRowData = vsoDataRecordset.GetRowData(lngRow)

        shpObj.Name = varRowData(6)
        shpObj.Text = varRowData(7)

        ' connect the shapes ...
        shpFrom = activePageObj.Shapes(varRowData(4))
        shpTo = activePageObj.Shapes(varRowData(5))
        shpFrom.AutoConnect shpTo, visAutoConnectDirNone

    Else
        Debug.Print ("LINK SKIPPED:" & varRowData(2) & " : " & varRowData(0))
    End If

Next lngRow

结束子

这是我一直用来测试的数据文件...(复制并粘贴到 Excel 中)

1,,ENTITY,A,,,1,1: A,ONE
2,,ENTITY,B,,,2,2: B,TWO
3,,ENTITY,C,,,3,3: C,THREE
13,1,LINK,LINK1,A,B,13.1,13.1: LINK1,LINK1
13,2,LINK,LINK2,A,C,13.2,13.2: LINK2,LINK2
13,2,LINK,LINK2,C,B,13.2,13.2: LINK2,LINK2
4

1 回答 1

1

此代码应该适合您:

Public Sub DrawSystem()

Dim strConnection As String
Dim strCommand As String
Dim vsoDataRecordset As Visio.DataRecordset

strConnection = "Provider=Microsoft.ACE.OLEDB.12.0;" _
                   & "User ID=Admin;" _
                   & "Data Source=" + "d:\Book1.xlsx;" _
                   & "Mode=Read;" _
                   & "Extended Properties=""HDR=YES;IMEX=1;MaxScanRows=0;Excel 12.0;"";" _
                   & "Jet OLEDB:Engine Type=34;"

strCommand = "SELECT * FROM [Sheet1$]"

Set vsoDataRecordset = ActiveDocument.DataRecordsets.Add(strConnection, strCommand, 0, "Objects")

Dim stnObj As Visio.Document
Dim mastObj As Visio.Master
Dim pagsObj As Visio.Pages
Dim pagObj, activePageObj As Visio.Page
Dim shpObj As Visio.Shape
Dim shpFrom As Visio.Shape
Dim shpTo As Visio.Shape

Set stnObj = Documents.OpenEx("Basic Shapes.vss", visOpenDocked)

Set pagObj = ThisDocument.Pages.Add()

Dim lngRowIDs() As Long
Dim lngRow As Long
Dim lngColumn As Long
Dim varRowData As Variant

Debug.Print "PROCESSING ENTITY RECORDS"
lngRowIDs = vsoDataRecordset.GetDataRowIDs("")

Set mastObj = stnObj.Masters("Rectangle")

For lngRow = LBound(lngRowIDs) To UBound(lngRowIDs)

    varRowData = vsoDataRecordset.GetRowData(lngRow)

    If varRowData(2) = "ENTITY" Then

        Set shpObj = pagObj.Drop(mastObj, lngRow / 2, lngRow / 2)

        shpObj.Name = varRowData(3)
        shpObj.Text = varRowData(7)
        shpObj.Data1 = varRowData(3)
        shpObj.Data2 = varRowData(7)
        shpObj.Data3 = varRowData(8)

        shpObj.Cells("Width") = 0.75
        shpObj.Cells("Height") = 0.5

    End If

Next lngRow

lngRowIDs = vsoDataRecordset.GetDataRowIDs("")

Set mastObj = stnObj.Masters("Dynamic Connector") 

For lngRow = LBound(lngRowIDs) To UBound(lngRowIDs)

    varRowData = vsoDataRecordset.GetRowData(lngRow)
    Debug.Print ("!ddd!!" & varRowData(2))

    If varRowData(2) = "LINK" Then

        Dim fromName As String
        fromName = varRowData(4)

        Dim toName As String
        toName = varRowData(5)

        Dim conName As String
        conName = varRowData(6)


        Set shpCon = pagObj.Drop(mastObj, 2 + lngRow * 3, 0 + lngRow * 3)
        varRowData = vsoDataRecordset.GetRowData(lngRow)

        shpCon.Name = conName
        shpCon.Text = varRowData(7)

        Set shpFrom = ActivePage.Shapes(fromName)
        Set shpTo = ActivePage.Shapes(toName)
        shpFrom.AutoConnect shpTo, visAutoConnectDirNone, shpCon
    End If

Next lngRow
End Sub
于 2013-10-31T10:33:59.343 回答