What is the best way to trigger a VBA Sub (or Function) from the ShapeSheet

[visProcessEng]

I have got the below bit of code to work pretty well.

What I hope to have when I am done is a VBA Function (or Subroutine) that will keep track of all connections (from and to) for each shape. 

So the event that I would like to have trigger the function would be a change in the connections (at document or page level it not clear to me).

What the code currently does (in effect) is to append a number of rows at the end of the Scratch Section (could be User Defined or Shape Data if prefered) equal to the number of existing connections of a given shape. 

Any ideas?  I have a copy of Visio 2003 Developers Survivial Pack, but would prefer not haveing to dig into this topic.  Also there are so many options that I would prefer having input from someone who has done something like this, as I have had enough frustration getting to where I am.

Code Select Expand


Public Sub Connection_Tracker()

Dim visShape As Visio.Shape
Dim visCell As Visio.Cell
Dim visShapeID As String
Dim selected_cnt As Integer
Dim connector_cnt As Integer
Dim idxFirstCTbl_row As Integer
Dim idxCTbl As Integer

Dim CTbl_row_cnt As Integer

Dim scratch_rows_cnt As Integer
Dim cell_name As String
Dim i As Integer
Dim dummy As String
Dim Table_Tag As String

Table_Tag = """CTbl"""
CTbl_row_cnt = 0
'************Verify that one and only one shape is selected, else error message******
    selected_cnt = Application.ActiveWindow.Selection.Count
   
    If selected_cnt <> 1 Then
        MsgBox ("Please Select one and only one shape for this function to work properly")
    Else
    End If
'**************************************************************************************
'************Set the Shape Object to be processed**************************************
    Set visShape = Application.ActiveWindow.Selection.Item(1)
    visShapeID = visShape.NameID

'**************************************************************************************
'************Check for existing "Connection Table") NOTE visSectionScratch = 6*********
    'Check that there is a scratch section, if NOT then create one
    If Not (visShape.SectionExists(6, 1)) Then
        visShape.AddSection (6)
    End If
        'Count number of Rows in Scratch Section
        scratch_rows_cnt = visShape.RowCount(6)
        'Identify range of "Connection Table" if any NOTE that Indexes begin with "0"
        dummy = ""
        idxFirstCTbl_row = 0
        idxCTbl = 0
       
        For i = 0 To scratch_rows_cnt
            Set visCell = visShape.CellsSRC(6, i, 5)
            dummy = visCell.Formula
            If dummy = Table_Tag Then
                If idxFirstCTbl_row = 0 Then
                    idxFirstCTbl_row = i
                End If
            idxCTbl = idxCTbl + 1
            End If
        Next i
       
        CTbl_row_cnt = idxCTbl
        'Determine if any rows have been added below the "Connector Table"
        'if so delete the existing "Connector Table"
        'the "Connector Table" will then be appended at the bottom of scratch.
        If idxFirstCTbl_row + CTbl_row_cnt < scratch_rows_cnt Then
            For j = 1 To CTbl_row_cnt
                'NOTE idxFirstCTbl_row + CTbl_row_cnt is used to start the deletion process from the bottom up
                i = idxFirstCTbl_row + CTbl_row_cnt - j
                visShape.DeleteRow visSectionScratch, i
            Next j
        'Set the count of "Connector Table" to zero as they have all been deleted
            CTbl_row_cnt = 0
        End If
'**************************************************************************************
'************Compare Number of Connections to the existing number of "Connections Table" rows
            'then append sufficient rows to allow for new connections
                'Count number of connections to shape
                connector_cnt = visShape.FromConnects.Count
'************Compare number of rows to append
                If connector_cnt > CTbl_row_cnt Then
                    For i = 1 To connector_cnt - CTbl_row_cnt
                        visShape.AddRow visSectionScratch, visRowLast, 0
                        Set visCell = visShape.CellsSRC(6, visRowLast, 5)
                        visCell.Formula = Table_Tag
                    Next i
                End If
'************Or Delete excess rows
                If connector_cnt < CTbl_row_cnt Then
                    For i = 1 To CTbl_row_cnt - connector_cnt
                        visShape.DeleteRow visSectionScratch, visRowLast
                    Next i
                End If


End Sub



[Visio Guy]

Hi VPE,

You could watch these Page events:

• ConnectionsAdded
• ConnectionsDeleted
• BeforeSelectionDelete

You need to watch for deletion, because when shapes get deleted, you don't get a ConnectionsDeleted event!

[visProcessEng]

Don't suppose anyone might have some example VBA code that responds to a change in the "PAGE" connections collection.

Just hoping