CODEWITHSUNDEEP
excelvbavisio
powerkor
powerkor

Reputation: 31

VBA from excel cannot visio autoconnect two shapes

I am trying to generate a Visio from inside Excel. I can get the shapes to show up but the autoconnect method bombs out with a 'Type Mismatch' error. I've also tried the GlueTo method with no luck either.

Could it be because the shpObj isn't a real Shape? I need help figuring how if that's the case and how to better store the shape, or retain the shapeID if possible.

shpFrom is just the first shpObj... Here is how I drop the shape into the Visio:

Set shpObj = AppVisio.ActiveWindow.Page.Drop(AppVisio.Documents.Item("Computers and Monitors.vss").Masters.Item("PC"), dXPos, yPos)

Here's how I try to connect them:

shpObj.AutoConnect shpFrom, visAutoConnectDirUp

Seems straight forward enough, but I cannot get it to work. Here is all the code:

Sub VisioFromExcel()
    Set AppVisio = CreateObject("visio.application")
    AppVisio.Visible = True
    AppVisio.Documents.AddEx "Basic Network Diagram.vst", visMSmetric, 0
    ComputerStencil = AppVisio.Documents.AddEx("Computers and Monitors.vss", visOpenRO + visOpenDocked)
    Connector = AppVisio.Documents.AddEx("Connectors.vss", visOpenRO + visOpenDocked)

    AppVisio.Windows.ItemEx(1).Activate
    dXPos = AppVisio.ActivePage.PageSheet.Cells("PageWidth") / 2
    dYPos = AppVisio.ActivePage.PageSheet.Cells("PageHeight") / 2
    yPos = 1

    For x = 4 To 6
    'For x = 4 To Worksheets("Inventory").Cells(Rows.Count, 1).End(xlUp).Row
        Set shpObj = AppVisio.ActiveWindow.Page.Drop(AppVisio.Documents.Item("Computers and Monitors.vss").Masters.Item("PC"), dXPos, yPos)
        If x = 4 Then
            shpFrom = shpObj
        Else
            'shpObj.GlueTo shpFrom
            'Set line1 = AppVisio.ActiveWindow.Page.Drop(AppVisio.ConnectorToolDataObject, 1, 2)
            'line1.CellsU("BeginX").GlueTo shpFrom.CellsU("PinX")
            'line1.CellsU("EndX").GlueTo shpObj.CellsU("PinX")
            shpObj.AutoConnect shpFrom, visAutoConnectDirUp
        End If

        'Level testing for positioning?
        'If Len(objName) > 0 Then
        'End If

        objName = Worksheets("Inventory").Cells(x, 1).Value
        shpObj.Text = objName
        yPos = yPos - 1.25
    Next
    'AppVisio.ActiveWindow.Page.CenterDrawing
    AppVisio.ActiveWindow.Page.ResizeToFitContents
    Set AppVisio = Nothing
End Sub

Upvotes: 0

Views: 474

Answers (1)

Nikolay
Nikolay

Reputation: 12245

In VBA, when assigning objects, you should use "Set":

If x = 4 Then
    Set shpFrom = shpObj    ' Note Set !
Else
    ....

Upvotes: 1

Related Questions