Ajouter & Lier des formes - VBA
Sub Macro7()
Dim i As Integer
Dim j As Visio.Shape
Dim GetShape As Visio.Shape
Dim vso1DShape1 As Visio.Cell
Dim vso2DShape2 As Visio.Cell
'Supprimer les formes
Do While ActivePage.Shapes.Count > 0
ActivePage.Shapes(1).Delete
Loop
'Ajouter les projets
For i = 0 To 1
Dim ShpObj As Visio.Shape
Set ShpObj = ActivePage.Drop(Application.Documents("BSTORM_M.VSS").Masters("Main topic"), 5 + i, 5 + i)
ShpObj.Characters.Text = "coucou" & i
Next
'Ajouter les connexions
Application.ActiveWindow.Page.Drop Application.Documents.Item("BSTORM_M.VSS").Masters.ItemU("Dynamic connector"), 1, 1
'Lier les projets
Dim vsoCellBegin As Visio.Cell
Dim vsoCellEnd As Visio.Cell
Set vsoCellBegin = ActivePage.Shapes.ItemFromID(3).CellsU("BeginX")
Set vsoCellEnd = ActivePage.Shapes.ItemFromID(3).CellsU("EndX")
Set vso1DShape1 = ActivePage.Shapes.ItemFromID(1).Cells("Connections.X2")
Set vso2DShape2 = ActivePage.Shapes.ItemFromID(2).Cells("Connections.X1")
vsoCellBegin.GlueTo vso1DShape1
vsoCellEnd.GlueTo vso2DShape2
' Set vsoCell2 = ActivePage.Shapes(1).Cells("Connections.X2")
' vsoCell1.GlueTo vsoCell2
' Set vsoCell2 = ActivePage.Shapes(2).Cells("Connections.X1")
' vsoCell1.GlueTo vsoCell2
End Sub