How to connect visio shapes on page by passing shape name with variable?

Started by Michael Ziegler, August 13, 2019, 04:07:48 PM

Previous topic - Next topic

0 Members and 1 Guest are viewing this topic.

Michael Ziegler

I am trying to connect the visio shapes in my drawing. I am using autoconnect. I have a loop that goes thru all the visio shapes in my drawing. It goes thru the values in my range and compares them to the shape name, if the shape name matches then it should connect to the shape who has the name stored in the offset (0, 2) of my range variable but I'm having problems passing the variable to the script. If I do a debug print for the variable that stores the shape names to connect to then it prints to screen the names of the shapes that the current shape in the loop needs to connect to. So it has the correct data.

Here is some of the code.

Dim conns As Range

    Dim connto_str As String

    Dim ew As Excel.Workbook

    Set ew = wbkInst.ActiveWorkbook

    Dim conns As Range

    Dim cel As Range

    Dim ws As Worksheet


    For Each ws In ew.Sheets

        Set conns = ws.Range("j3:j22")


        For Each cel In conns


            With cel

                c = cel.Value


                connto_str = cel.Offset(0, 2).Value 


            End With


            For Each node In ActivePage.Shapes

                If node.Name = c Then

                node.AutoConnect connto_str, visAutoConnectDirNone


                'Debug.Print connto_str


                Else

                End If


            Next node

        Next cel


    Next ws


I need to be able to pass the content of the variable to this statement.
node.AutoConnect connto_str, visAutoConnectDirNone
Thanks


Surrogate


OldSchool1948

I use this sub-routine to autoconnect shapes on a page to rows in a spreadsheet. 

Private Sub autoLinkDfdShapes( _
                vsoDocument As Visio.Document, _
                vsoPage As Visio.Page, _
                wrkSheetName As String, _
                keyCol As String, _
                keyField As String)

On Error GoTo ErrorHandlerOpenProjectDefinitionWorkbook
   
    Dim vsoDataRecordSet As Visio.DataRecordset
    Dim vsoSelection As Visio.Selection
    Dim columnNames(1) As String
    Dim fieldTypes(1) As Long
    Dim fieldNames(1) As String
    Dim shapesLinked() As Long
    Dim i As Integer
   
    Dim intCount As Integer
    intCount = vsoDocument.DataRecordsets.Count
   
    columnNames(1) = keyCol
    fieldTypes(1) = Visio.VisAutoLinkFieldTypes.visAutoLinkCustPropsLabel
    fieldNames(1) = keyField
   
    For i = 1 To intCount
           
        Set vsoDataRecordSet = vsoDocument.DataRecordsets(i)
       
        If vsoDataRecordSet.Name = wrkSheetName Then
               
            Set vsoSelection = vsoPage.CreateSelection(visSelTypeAll, _
                    visSelModeSkipSuper, vsoPage)
                                                   
            vsoSelection.AutomaticLink _
                            vsoDataRecordSet.ID, _
                            columnNames, _
                            fieldTypes, _
                            fieldNames, _
                            visAutoLinkIncludeHiddenProps + _
                            visAutoLinkNoApplyDataGraphic + _
                            visAutoLinkSelectedShapesOnly, _
                            shapesLinked
                           
            Exit For
                           
        End If
                           
    Next i
   
exitHereOpenProjectDefinitionWorkbook:
       
    On Error GoTo 0
   
    Exit Sub

ErrorHandlerOpenProjectDefinitionWorkbook:  ' Error-handling routine.

    Call showProgramError
   
    Resume exitHereOpenProjectDefinitionWorkbook

End Sub


A couple of things to keep in mind:

  • keyCol is the spreadsheet column name
  • keyField is the dataset key field name.

Following the KISS principle, use the same name for both the shape data key field and workbook key field.  My shape data key fields are hidden; however, to autoconnect a key field must be visible.  I use this sub to make the keyfield visible and invisible.

Public Sub setPropSectionRowInvisible( _
                vsoPage As Visio.Page, _
                strCellname As String, _
                inVisible As Boolean)

    Dim vsoshape As Visio.Shape
    Dim iRow As Integer
   
    For Each vsoshape In vsoPage.Shapes
   
        If isShapeServer(vsoshape) Then
       
            If vsoshape.CellExists(strCellname, Visio.visExistsAnywhere) Then
       
                iRow = vsoshape.CellsRowIndex(strCellname)
                vsoshape.CellsSRC(visSectionProp, iRow, _
                        visCustPropsInvis).formula = inVisible
   
            End If

        End If
   
    Next vsoshape
       
End Sub


Here's sample code that puts the above two routines in context.  Hopefully, you can modify it to meet your needs.

Public Sub relinkServerShapesCloud()

    Dim vsoDocument As Visio.Document
    Set vsoDocument = ThisDocument
   
On Error GoTo errHandler
       
    Dim i As Integer
    Dim vsoPage As Visio.Page
    For Each vsoPage In vsoDocument.Pages
                                   
        If isPageCloudAppSys(vsoPage) And _
            isPageTabVisible(vsoPage) = True Then
                                                 
            ''''''''''''''''''''''''''''
            '/  Relink Cloud Server Shapes
            ''''''''''''''''''''''''''''
            Call setPropSectionRowInvisible( _
                    vsoPage, _
                    C_PRIMARY_KEY_CLOUD, _
                    False)
               
            Call autoLinkDfdShapes( _
                    vsoDocument, _
                    vsoPage, _
                    C_SHEETNAME_CLOUD, _
                    C_PRIMARY_KEY_CLOUD, _
                    C_PRIMARY_KEY_CLOUD)
                   
            Call setPropSectionRowInvisible( _
                    vsoPage, _
                    C_PRIMARY_KEY_CLOUD, _
                    True)
                   
        End If

    Next vsoPage
   
cleanExit:

    On Error GoTo 0
   
    Exit Sub
   
errHandler:

    Call showProgramError
   
    Resume cleanExit

End Sub