Visio 2010 VBA autoconnect

Question

第一次使用Visio在VBA编码的用户在这里！

我使用Visio 2010专业版

我试图自动化使用VBA的系统架构图的绘制。数据源是一个Excel工作表。 （！感谢大家）Hopefully this is the result...

我已经写了VBA读取Excel工作表，并可以从网上一点帮助在页面上创建形状

我一直在寻找采取的路径是：

• 删除对象对于每个第一
• 系统通过记录使用自动连接，环的和绘制系统 之间的链接（表示积分）
  • 从Excel数据，链接知道他们正在连接的形状的名称（当我放下页面上的形状时，我分配shape.name）。

我不知道如何使用形状名称来标识一个独特的形状对象（可以用作自动连接方法参数）

有没有更好的或者更简单的方法做这个？

我见过Autoconnect示例（http://msdn.microsoft.com/en-us/library/office/ms427221%28v=office.12%29.aspx）;如果我有在运行时创建的对象的句柄（即为每个创建的对象的变量）工作正常。在我的情况下，我不存储在任何地方。我考虑将这些信息存储在一个数组中，然后通过相同的循环找对象。

我想一些想法，以做到这一点的最好办法。鉴于我是一个新手的Visio，一些样品（工作？）代码将非常受欢迎。

代码我特别感兴趣的是整理出“连接形状...”

我遇到的另一个小问题是，每次运行VBA时都会创建一个新的模板，我该如何选择掌握而不做S'

非常感谢！

我不知道信息的人会多么需要得到一个想法是什么，我想实现等方面都附加我写的代码/砍死/抄袭至今

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 

Answer 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