第一次使用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:visioObjects2;" _
& "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
这段代码应该适合你：
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