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