VBA on dynamic connector in Visio-CodePudding

I am just beginner at programming with VBA on Visio. What I am looking to do is to write a code that automatically draws a connector between two shapes.

Searching on internet I was able to find a code that does that :

Public Sub AutoConnect_Example()

Dim vsoShape1 As Visio.Shape 
Dim vsoShape2 As Visio.Shape 
Dim vsoConnectorShape As Visio.Shape 

Set vsoShape1 = Visio.ActivePage.Shapes("Decision") 
Set vsoShape2 = Visio.ActivePage.Shapes("Process") 
Set vsoConnectorShape = Visio.ActivePage.Shapes("Dynamic connector") 

vsoShape1.AutoConnect vsoShape2, visAutoConnectDirRight, vsoConnectorShape

End Sub

The only thing I want to do now is to be able to add a text on the connector. Let's say add "SSL" on the connector and if possible change to color of the connector to red.

Does anyone knows what is the formula please ? My objective will be to add it to the code just below.

Hope my English isn't too bad. Thanks all for any help.

Raph

CodePudding user response：

The only thing I want to do now is to be able to add a text on the connector. Let's say add "SSL" on the connector and if possible change to color of the connector to red.

Raph, try add these lines to your code

vsoConnectorShape.Text = "SSL" ' add text to connector
vsoConnectorShape.CellsSRC(visSectionObject, visRowLine, visLineColor).FormulaU = 2 ' make connector red
vsoConnectorShape.CellsSRC(visSectionObject, visRowLine, visLineEndArrow).FormulaU = "1" ' add arrow to end

CodePudding user response：

I modify and mix codes from official MS manuals

Sub ForRaphael()
' This part of the code contains the declaration of variables: existing shapes and connector
' Code borrowed from: https://docs.microsoft.com/en-us/office/vba/api/visio.shape.autoconnect
 Dim vso1DShape As Visio.Shape
 Dim vso2DShape1 As Visio.Shape
 Dim vso2DShape2 As Visio.Shape
 Dim vsoCellGlueFromBegin As Visio.Cell
 Dim vsoCellGlueFromEnd As Visio.Cell
  ' Existing connector
 Set vso1DShape = Visio.ActivePage.Shapes("Dynamic connector")
  ' Existing Decision shape
 Set vso2DShape1 = Visio.ActivePage.Shapes("Decision")
  ' Existing Process shape.
 Set vso2DShape2 = Visio.ActivePage.Shapes("Process")
' -------
' This part of the code contains gluing the ends of the connector to the existing shapes.
' The idea of this part is borrowed: https://docs.microsoft.com/en-us/office/vba/api/visio.cell.gluetopos
' -------
 Set vsoCellGlueFromBegin = vso1DShape.Cells("BeginX")
 Set vsoCellGlueFromEnd = vso1DShape.Cells("EndX")
  'Use the GlueToPos method to glue the begin point of the 1D shape
 'to the top center of the lower 2D shape.
 vsoCellGlueFromBegin.GlueToPos vso2DShape1, 0.5, 1
  'Use the GlueToPos method to glue the endpoint of the 1D shape
 'to the bottom center of the upper 2D shape.
 vsoCellGlueFromEnd.GlueToPos vso2DShape2, 0.5, 0
' =======
' This part of the code is suggested by Surrogate
' =======
vso1DShape.Text = "SSL" ' add text to connector
vso1DShape.CellsSRC(visSectionObject, visRowLine, visLineColor).FormulaU = 2 ' make connector red
vso1DShape.CellsSRC(visSectionObject, visRowLine, visLineEndArrow).FormulaU = "1" ' add arrow to end
End Sub

Hope this code works at your side :)