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 |
