Visio 2010 VBA autoconnect

Question

First time user of VBA coding with Visio here!

I am using Visio 2010 Pro

I am trying to automate a the drawing of a system architecture diagram using VBA. The data source is an Excel sheet. Hopefully this is the result...

I have written VBA to read the Excel sheet, and can create the shapes on the page with a bit of help from the internet (thanks everyone!)

The path I was looking to take was:

• Drop Objects for each of the systems first
• Using autoconnect, loop through the recordset and draw the links (showing the integration) between systems
  • From the Excel data, the links know the name of the shapes they are connecting (and I assign the shape.name when I drop the shapes on the page).

I do not know how to use the shape name to identify a unique shape object (which could be used as parameters for the autoconnect method)

Is there a better or easier way to do this?

I have seen the Autoconnect example (http://msdn.microsoft.com/en-us/library/office/ms427221%28v=office.12%29.aspx); which works fine if I have a handle on the objects created at run time (I.e. a variable for each object created. In my case, I am not storing that anywhere. I gave thought to storing this info in an array and then looping through same to find the object.

I’d like some thoughts as to the best way to do this. Given I am a Visio newbie, some sample (working?) code would be very well received.

The code I am particularly interested in sorting out is commented with "connect the shapes..."

One other little issue I have; is that a new stencil is created every time that I run the VBA. How can I still choose a master without doing this?

Many thanks!

I wasn’t sure how much info people would need to get an idea as to what I am trying to achieve and so have attached the code I’ve written/hacked/plagiarised to date

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

End Sub

Here is the data file that I have been using to test ... (copy and paste into 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

This code should work for you:

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