Change Row-Type with VBA

[Jumpy]

I want to add a new Connection Point to a shape with VBA. No problem so far.

But now I want either to change the Row-Type of the new row after I added it (with VBA) or I want to directly add a Row of the other Rowtype. How can I do this.

The reason for changing the rowtype is that I want to use the column D, too, which is not possible with standard Connection Point.

[bobsupercow]

Here you go:

You can modify it to fit your needs. You'll have to set your shape, etc.

It loops through and sets all the connection points to typeABCD. You could just add the line of code that does this to your existing code if you already have the connection point row you want to edit.

Code Select Expand


Sub connectionPtToDType()
   'Declare your shape
   Dim vsoShape As Visio.Shape
   'Row Counter
   Dim currentRow As Integer
   'Set your shape here.
   Set vsoShape = Application.ActivePage.Shapes(1)

   'Make sure the section exists
   If vsoShape.SectionExists(Visio.VisSectionIndices.visSectionConnectionPts, Visio.VisExistsFlags.visExistsAnywhere) Then
       'Loop through each connection point in the shape
       For currentRow = 0 To vsoShape.Section(Visio.VisSectionIndices.visSectionConnectionPts).Count - 1
       'Set the RowType
       vsoShape.RowType(Visio.VisSectionIndices.visSectionConnectionPts, _
                        currentRow) = _
                        Visio.VisRowTags.visTagCnnctPtABCD
       'Set the Formula of the D Cell
       vsoShape.CellsSRC(Visio.VisSectionIndices.visSectionConnectionPts, _
                         currentRow, _
                         Visio.VisCellIndices.visCnnctD).FormulaU = _
                         True
   Next currentRow
   End If
End Sub

Sub connectionPtToDefault()
   'Declare your shape
   Dim vsoShape As Visio.Shape
   'Row Counter
   Dim currentRow As Integer
   'Set your shape here.
   Set vsoShape = Application.ActivePage.Shapes(1)

   'Make sure the section exists
   If vsoShape.SectionExists(Visio.VisSectionIndices.visSectionConnectionPts, Visio.VisExistsFlags.visExistsAnywhere) Then
       'Loop through each connection point in the shape
       For currentRow = 0 To vsoShape.Section(Visio.VisSectionIndices.visSectionConnectionPts).Count - 1
       'Set the RowType
       vsoShape.RowType(Visio.VisSectionIndices.visSectionConnectionPts, _
                        currentRow) = _
                        Visio.VisRowTags.visTagCnnctPt
   Next currentRow
   End If
End Sub


[Jumpy]

Thanks for pointing me in the right direction. Because I used AddNamedRow, to add a new ConnectionPoint, I had to use visTagCnnctNamedABCD instead of visTagCnnctPtABCD, but that was just a little bit of try and error and than it was done. Here's my code:

Code Select Expand


Sub AlterShape(shp As Shape, Optional Rekursiv As Boolean = True)
  Dim subshp As Shape, a As Integer
 
  'Do sth. to the shape and/or search for sth.
  If shp.CellExists("User.Pumpe_sichtbar", False) Then
    For i = 3 To 6
      '------------------------------------------------------------------------------
      'Here Row is added and RowType switched:
      a = shp.AddNamedRow(visSectionConnectionPts, "Strom" & i, 0)
      shp.RowType(visSectionConnectionPts, a) = visTagCnnctNamedABCD
      shp.Cells("Connections.Strom" & i & ".D").Formula = Chr(34) & "Strom" & Chr(34)
      '------------------------------------------------------------------------------
      shp.Cells("Connections.Strom" & i & ".C").Formula = 0
      shp.Cells("Connections.Strom" & i & ".A").Formula = "0 mm"
      shp.Cells("Connections.Strom" & i & ".B").Formula = "0 mm"
    Next i
    shp.Cells("Connections.Strom3.X").Formula = "Width*0.85"
    shp.Cells("Connections.Strom4.X").Formula = "Width*0.85"
    shp.Cells("Connections.Strom5.X").Formula = "Width*0.15"
    shp.Cells("Connections.Strom6.X").Formula = "Width*0.15"
    shp.Cells("Connections.Strom3.Y").Formula = "Height*0.85"
    shp.Cells("Connections.Strom4.Y").Formula = "Height*0.15"
    shp.Cells("Connections.Strom5.Y").Formula = "Height*0.85"
    shp.Cells("Connections.Strom6.Y").Formula = "Height*0.15"
  End If


  'Optional: Check Subshapes,too.
  If Rekursiv Then
    For Each subshp In shp.Shapes
      AlterShape subshp, True
    Next
  End If
End Sub



[bobsupercow]

No problem. Glad I could help.

Thanks for the info on the difference between the named and unnamed constants. I hadn't ever used them before so I didn't even know there was a difference. I'm guessing the Visio Engine uses that for like a Select Case statement to determine what fields to look at. Pretty neat.