ENUMÉRATION DE TOUS LES CHEMINS D'UN GRAPHE

Function roadmap(ByVal chem As String, ByVal ext As Variant, destination As String)

Dim successeurs As New Collection 'Contient les successeurs d'un noeud du graphe
Dim noeuds As New Collection      'contient tous les noeuds du graphe
Dim k, nod, s, tc As Variant
Dim adj(10, 10) As Variant

For k = 1 To 7 'remplir les noeuds
    noeuds.Add Item:=k
Next k

'matrice des adjacents : si est adjacent à j alors adj(i,j)=1
adj(1, 2) = 1
adj(2, 1) = 1
adj(1, 7) = 1
adj(7, 1) = 1
adj(2, 4) = 1
adj(4, 2) = 1
adj(2, 3) = 1
adj(3, 2) = 1
adj(2, 6) = 1
adj(6, 2) = 1
adj(3, 4) = 1
adj(4, 3) = 1
adj(4, 5) = 1
adj(5, 4) = 1
adj(5, 6) = 1
adj(6, 5) = 1
adj(6, 7) = 1
adj(7, 6) = 1

For Each k In noeuds 'calcul des successeurs d'un noeud
    If adj(ext, k) = 1 Then
        successeurs.Add Item:=k
    End If
Next k
If ext = destination Then 'Si on arrive à destination alors on écrit la solution         Debug.Print chem
Else
    For Each nod In successeurs
        If InStr(1, chem, nod, vbTextCompare) = 0 Then
            s = chem
            s = s & nod
            Call roadmap(s, nod, destination)
        End If
    Next nod
End If

End Function