Discussion :

[lmaniac]

Salut!

J'ai du mal à faire fonctionner le code "Change" "Add" et "Remove", mais je n'arrive pas à comprendre ce qui ne va pas ...

Quelqu'un peut-il aider?
merci!

[boisgontierjacques]

Bonjour,

Remarque: Le niveau dans le tableau n'est pas nécessaire.
Avec une procédure récursive, le tracé de l'organigramme se fait sans cette colonne.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Dim tw As MSComctlLib.TreeView
Dim n, Rng
Private Sub UserForm_Initialize()
  Set Rng = Range("A2:F" & [F65000].End(xlUp).Row)
  pere = Rng(1, 1)
  nomPere = Application.VLookup(pere, Rng, 4, False)
  Set tw = Nothing
  Set tw = Me.MonArbre
  n = Rng.Rows.Count
  tw.Nodes.Add(, , "NoeudMat" & pere, nomPere).Expanded = True    ' Racine arbre
  Fils pere
End Sub
 
Sub Fils(parent)       ' procédure récursive
  For i = 2 To n
    cd = Rng(i, 1)
    niv = Len(cd) - Len(Replace(cd, ".", ""))
    If niv = 0 Then temp = "0" Else temp = Left(cd, Len(cd) - 2)
    If temp = parent Then
      tw.Nodes.Add("NoeudMat" & parent, tvwChild, "NoeudMat" & _
        Rng(i, 1), Rng(i, 1) & ": " & Rng(i, 2) & "-" & Rng(i, 4)).Expanded = True
      Fils Rng(i, 1)
    End If
  Next i
End Sub

Boisgontier

[boisgontierjacques]

J'ai repris votre BD avec mon code en ne gardant que les colonnes utiles.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
Dim tw As MSComctlLib.TreeView
Dim n, Rng
Private Sub UserForm_Initialize()
  Set Rng = Range("A2:C" & [A65000].End(xlUp).Row)
  pere = "0"
  nomPere = Application.VLookup(pere, Rng, 2, False)
  Set tw = Me.MonArbre
  n = Rng.Rows.Count
  tw.Nodes.Add(, , "NoeudMat" & pere, nomPere).Expanded = True    ' Racine arbre
  Fils pere
End Sub
 
Sub Fils(parent)       ' procédure récursive
  For i = 2 To n
    cd = Rng(i, 1)
    niv = Len(cd) - Len(Replace(cd, ".", ""))
    If niv = 0 Then temp = "0" Else temp = Left(cd, Len(cd) - 2)
    If temp = parent Then
      tw.Nodes.Add("NoeudMat" & parent, tvwChild, "NoeudMat" & _
        Rng(i, 1), Rng(i, 1) & ": " & Rng(i, 2) & "-").Expanded = True
      Fils Rng(i, 1)
    End If
  Next i
End Sub
 
Private Sub MonArbre_NodeClick(ByVal Node As MSComctlLib.Node)
  If Left(Node.Key, 8) = "NoeudMat" Then
    Me.code = Application.VLookup(Mid(Node.Key, 9), Rng, 1, False)
    Me.Description = Application.VLookup(Mid(Node.Key, 9), Rng, 2, False)
    Me.Valeur = Application.VLookup(Mid(Node.Key, 9), Rng, 3, False)
  End If
End Sub
 
Private Sub B_modif_Click()
  Set result = Rng.Find(what:=Me.code)
  If Not result Is Nothing Then
    ligne = result.Row - 1
    Rng(ligne, 2) = Me.Description
    Rng(ligne, 3) = CDbl(Me.Valeur)
  End If
End Sub
 
Private Sub b_sup_Click()
  Set result = Rng.Find(what:=Me.code)
  If Not result Is Nothing Then
    ligne = result.Row - 1
    If MsgBox("Etes vous sûr de supprimer " & Me.code & "?", vbYesNo) = vbYes Then
      Rng.Rows(ligne).Delete
      tw.Nodes.Clear
      UserForm_Initialize
    End If
  End If
End Sub
 
Private Sub B_ajout_Click()
  Set f = Sheets("bd")
  ligne = f.[A65000].End(xlUp).Row + 1
  f.Cells(ligne, 1) = Me.code
  f.Cells(ligne, 2) = Me.Description
  f.Cells(ligne, 3) = CDbl(Me.Valeur)
  tw.Nodes.Clear
  UserForm_Initialize
End Sub

Boisgontier