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