QuotevsoShp.AddRow visSectionConnectionPts, iRow, 0
vsoShp.DeleteRow visSectionConnectionPts, iRow
vsoShp.AddNamedRow visSectionConnectionPts, "P" & iRow, visTagCnnctNamedABCD
ActivePage.Shapes(1).AddRow visSectionConnectionPts, 0, visTagCnnctPt
Sub ConnPts()
Dim vsoShp As Visio.Shape
Dim iRow As Integer
iRow = 0
Set vsoShp = ActiveWindow.Selection(1)
vsoShp.AddRow visSectionConnectionPts, iRow, 0
vsoShp.DeleteRow visSectionConnectionPts, iRow
vsoShp.AddNamedRow visSectionConnectionPts, "P" & iRow, visTagCnnctNamedABCD 'Row index starts at "0", but want names to start at "1"
Set vsoRow = vsoShp.Section(visSectionConnectionPts).Row(iRow)
With vsoRow
.Cell(visCnnctX).FormulaU = "Width*0"
.Cell(visCnnctY).FormulaU = "Height*0.5"
End With
vsoShp.AddNamedRow visSectionConnectionPts, "P" & iRow + 1, visTagCnnctNamedABCD 'Row index starts at "0", but want names to start at "1"
vsoShp.DeleteRow visSectionConnectionPts, iRow + 1
vsoShp.AddRow visSectionConnectionPts, iRow + 1, 0
Set vsoRow = vsoShp.Section(visSectionConnectionPts).Row(iRow + 1)
With vsoRow
.Cell(visCnnctX).FormulaU = "Width*1"
.Cell(visCnnctY).FormulaU = "Height*0.5"
End With
vsoShp.AddRow visSectionConnectionPts, iRow + 2, 0
Set vsoRow = vsoShp.Section(visSectionConnectionPts).Row(iRow + 2)
With vsoRow
.Cell(visCnnctX).FormulaU = "Width*0.5"
.Cell(visCnnctY).FormulaU = "Height*1"
End With
End Sub
Dim s As Shape
Set s = ActivePage.DrawRectangle(0, 0, 1, 1)
s.AddSection visSectionConnectionPts
s.AddRow visSectionConnectionPts, 0, visTagCnnctPt
s.DeleteRow visSectionConnectionPts, 0 ' <<< deleted the last row in the section
s.AddNamedRow visSectionConnectionPts, "HELLO", visTagCnnctNamed ' << BOOOM!! Empty section prohibits adding named rows
Dim s As Shape
Set s = ActivePage.DrawRectangle(0, 0, 1, 1)
s.AddSection visSectionConnectionPts
s.AddNamedRow visSectionConnectionPts, "HELLO", visTagCnnctNamed
s.DeleteRow visSectionConnectionPts, 0 ' <<< deleted the last row in the section
s.AddRow visSectionConnectionPts, 0, visTagCnnctPt ' << BOOOM!!! Empty section prohibits adding unnamed rows
Sub ttt()
Dim shp As Visio.Shape
Set shp = ActiveWindow.Selection(1)
Set mShape = shp.MasterShape
If Not mShape Is Nothing Then
If mShape.SectionExists(visSectionConnectionPts, 0) Then
Debug.Print mShape.RowType(visSectionConnectionPts, 0)
End If
End If
End Sub
Sub ConnPts()
Dim vsoShp As Visio.Shape
Dim iRow As Integer
Dim vsoRow As Visio.Row
iRow = 0
Set vsoShp = ActiveWindow.Selection(1)
vsoShp.AddRow visSectionConnectionPts, iRow, 0
Set vsoRow = vsoShp.Section(visSectionConnectionPts).Row(iRow)
With vsoRow
.Cell(visCnnctX).FormulaU = "Width*0"
.Cell(visCnnctY).FormulaU = "Height*0.5"
End With
vsoShp.AddNamedRow visSectionConnectionPts, "P" & iRow + 1, visTagCnnctNamedABCD
Set vsoRow = vsoShp.Section(visSectionConnectionPts).Row(iRow + 1)
With vsoRow
.Cell(visCnnctX).FormulaU = "Width*1"
.Cell(visCnnctY).FormulaU = "Height*0.5"
End With
vsoShp.AddRow visSectionConnectionPts, iRow + 2, 0
Set vsoRow = vsoShp.Section(visSectionConnectionPts).Row(iRow + 2)
With vsoRow
.Cell(visCnnctX).FormulaU = "Width*0.5"
.Cell(visCnnctY).FormulaU = "Height*1"
End With
End Sub
Sub AddConnectionPointRow(s As Shape)
On Error GoTo IsNamed
s.AddRow visSectionConnectionPts, 0, visTagCnnctPt
GoTo Done
IsNamed:
s.AddRow visSectionConnectionPts, 0, visTagCnnctNamed
Done:
End Sub
void AddConnectionPointRow(Shape s) {
try {
s.AddRow(VisSectionIndices.visSectionConnectionPts, 0, VisRowTags.visTagCnnctPt)
} catch {
s.AddRow(VisSectionIndices.visSectionConnectionPts, 0, VisRowTags.visTagCnnctNamed)
}
}