Sub associé à un checked treeview

**many6976** · 28/08/2013, 11h45

Bonjour,

Étudiante en Mécanique, je suis en plein stage (no rest for the wicked!), et essaie de mettre en place une base de données de composants de visserie, à laquelle j'associe un fichier excel ("base_visserie"), qui répertorie tous les composants. Dans la base "physique" contenant les fichiers 3D de chaque dossier de type de composant, j'ai un fichier excel qui répertorie les composants d'un type, ma base_visserie regroupe donc tous ces fichiers excel (les met dans la même feuille), et fait correspondre leurs colonnes.
Cela marche très bien, mais je voudrais créer un Sub qui permettrait à l'utilisateur de mettre à jour une partie de base_visserie (au cas où une modification aurait été faite dans un fichier excel individuel), ou d'ajouter une nouvelle partie à partir d'un fichier excel ajouté.

Je ne peux pas simplement tout effacer et refaire base_visserie car si quelqu'un avait manuellement ajouté un composant à base_visserie sans ajouter le fichier excel respectif dans la base "physique", ces données ajoutées seraient perdues.

J'ai donc créer un sub qui - après avoir répertorié tous les composants de la base "physique" - appelle un userForm en y créant un Treeview représentant l'arborescence des dossiers et sous-dossiers de la base "physique".
Ce userform demande quel(s) type(s) l'utilisateur souhaite mettre à jour ou ajouter.
L'utilisateur coche les cases qui l'intéressent et clique "OK".

Tout expliqué précédemment marche très bien, puis là arrive mon problème:
Mon userform ne traite que la première case cochée, alors que j'ai une boucle qui devrait parcourir tout le treeview. Je lui fais compter le nombre de noeud avant de commencer, et c'est tout bon.
J'ai beau lire et relire mon code, faire un essai papier, je n'arrive pas à trouver.
Voici le code du userForm:

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
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
Option Explicit
Dim oFSO As FileSystemObject
Dim oFld0 As Folder, oFld1 As Folder, oFld2 As Folder
Dim oFl0 As File, oFl1 As File
Dim oWB0 As Workbook, oWB1 As Workbook
Dim oWS0 As Worksheet, oWS1 As Worksheet
Dim nomBox As String, titreCol0 As String, titreCol1 As String, pathXLFile As String
Dim col0 As Integer, col1 As Integer, lastCol0 As Integer, lastCol1 As Integer, lastLin0 As Integer, lastLin1 As Integer, aftLastLin0 As Integer, aftLastCol0 As Integer, i As Integer
Dim ligneEmplacementDeb As Integer, ligneEmplacementFin As Integer
Dim colTrouvee As Boolean, rangeTrouve As Boolean
Dim rangeToDelete As Range, rangeDest As Range, foundRange As cLocatedRange
Dim racine As MSComctlLib.node
Dim nbreNoeud As Integer
 
Sub CommandButton1_Click() 'OK
 
    'On Error GoTo Handler1
    Application.Cursor = xlWait
    Set oFSO = New Scripting.FileSystemObject
    Set oFld0 = oFSO.GetFolder("C:\Documents and Settings\mclozel\Desktop\BASE DE DONNEES COMPOSANTS MECANIQUES\MODELES\VISSERIE")
    Set oFl0 = oFSO.GetFile("C:\Documents and Settings\mclozel\Desktop\base_visserie1.xls")
    Set oWB0 = Workbooks.Open(oFl0)
    Set oWS0 = oWB0.Sheets(1)
    With Me.TreeView1
    Set racine = .SelectedItem.root
    nbreNoeud = racine.Child.LastSibling.Child.LastSibling.Index
    MsgBox nbreNoeud
    For i = 1 To nbreNoeud   '<= c'est pour cette boucle que ça coince
        If .Nodes(i).Checked Then
            If Not .Nodes(i).Text = "VISSERIE" Then
                If Not .Nodes(i).Parent.Text = "VISSERIE" Then
                    'On Error GoTo Handler1
                    nomBox = NouvNom(.Nodes(i).Text)
                    MsgBox nomBox
                    pathXLFile = findXLFilePath(nomBox, oFld0)
                    Set foundRange = findRange(nomBox, oWS0)
                    MsgBox foundRange.trouve
'*************************************************************************
'S 'il trouve le type recherché dans base_visserie
                    If foundRange.trouve = True Then
                        'On Error GoTo Handler2
                        'Set rangeToDelete = foundRange.myRange
                        oWS0.Rows(foundRange.debut & ":" & foundRange.fin).EntireRow.Delete
                        Set oFl1 = oFSO.GetFile(pathXLFile)
                        Set oWB1 = Workbooks.Open(oFl1)
                        Set oWS1 = oWB1.Worksheets(1)
                        oWS0.Cells(foundRange.debut, 1).EntireRow.Resize(derLigne(oWS1) - 1).Insert
                        For col1 = 2 To derCol(oWS1)
                            titreCol1 = NouvNom(oWS1.Cells(1, col1).Value)
                            Set rangeDest = Nothing
                            For col0 = 1 To derCol(oWS0)
                                titreCol0 = UCase(NouvNom(CStr(oWS0.Cells(1, col0).Value)))
                                colTrouvee = False
                                If titreCol0 = titreCol1 Then
                                    oWS1.Activate
                                    Application.CutCopyMode = False
                                    oWS0.Range(oWS0.Cells(foundRange.debut, col0), oWS0.Cells(foundRange.fin, col0)).Value = oWS1.Range(Cells(2, col1), Cells(derLigne(oWS1), col1)).Value
                                    colTrouvee = True
                                    Exit For
                                End If
                            Next col0
                            If Not colTrouvee Then
                                aftLastCol0 = apresDerCol(oWS0)
                                oWS1.Activate
                                Application.CutCopyMode = False
                                oWS1.Range(Cells(2, col1), Cells(derLigne(oWS1), col1)).Select
                                Selection.Copy
                                oWS0.Activate
                                oWS0.Select
                                Set rangeDest = Evaluate(oWS0.Cells(foundRange.debut, aftLastCol0))
                                rangeDest.Insert Shift:=xlDown
                                oWS0.Cells(1, col0) = oWS1.Cells(1, col1)
                                Application.CutCopyMode = False
                            End If
                        Next col1
                        oWB1.Close False
'*************************************************************************
'S 'il ne trouve pas le type recherché dans base_visserie
                    Else
                        Set oWB1 = Workbooks.Open(pathXLFile)
                        Set oWS1 = oWB1.Worksheets(1)
                        lastLin0 = derLigne(oWS0)
                        aftLastLin0 = apresDerLig(oWS0)
                        MsgBox "***"
                        lastCol1 = derCol(oWS1)
                        For col1 = 2 To lastCol1
                            titreCol1 = NouvNom(CStr(oWS1.Cells(1, col1).Value))
                            Set rangeDest = Nothing
                            For col0 = 1 To derCol(oWS0)
                                titreCol0 = NouvNom(CStr(oWS0.Cells(1, col0).Value))
                                colTrouvee = False
                                If titreCol0 = titreCol1 Then
                                    oWS1.Activate
                                    Application.CutCopyMode = False
                                    oWS1.Range(Cells(2, col1), Cells(derLigne(oWS1), col1)).Select
                                    Selection.Copy
                                    oWS0.Activate
                                    oWS0.Select
                                    Set rangeDest = oWS0.Cells(aftLastLin0, col0)
                                    rangeDest.Select
                                    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                                    Application.CutCopyMode = False
                                    colTrouvee = True
                                    Exit For
                                End If
                            Next col0
                            If Not colTrouvee Then
                                aftLastCol0 = apresDerCol(oWS0)
                                oWS1.Activate
                                Application.CutCopyMode = False
                                oWS1.Range(Cells(2, col1), Cells(derLigne(oWS1), col1)).Value.Select
                                Selection.Copy
                                oWS0.Activate
                                oWS0.Select
                                Set rangeDest = oWS0.Cells(aftLastLin0, aftLastCol0)
                                rangeDest.Select
                                Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                                oWS0.Cells(1, col0) = oWS1.Cells(1, col1)
                                Application.CutCopyMode = False
                            End If
                        Next col1
                    End If
                End If
            End If
        End If
    Next i       '<= il ne le fait pas
    'MsgBox "Done_1"
    End With
 
    '*********************************************************************************
    'Mise en forme
    oWS0.Range("C2").Select
    ActiveCell.FormulaR1C1 = "=RC[-1]&"" ""&RC[1]&"" ""&RC[5]"
    oWS0.Range("C2").Select
    Selection.AutoFill Destination:=oWS0.Range("C2:C" & derLigne(oWS0))
    'MsgBox "Done_2"
    Application.Cursor = xlDefault
    oWS0.Cells.Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    oWS0.Rows("1:1").Select
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThick
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThick
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThick
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThick
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThick
        .ColorIndex = xlAutomatic
    End With
    'MsgBox "Done_3"
    'For i = 2 To derLigne(oWS0)
    'If WorksheetFunction.IsNA(Cells(i, 2)) = True Or oWS0.Cells(i, 2).Value = "" Then Rows(i).EntireRow.Delete
    'Next i
    Selection.EntireRow.AutoFit ' ajuste la taille de la 1ère ligne
    Application.Cursor = xlDefault
    Unload Me
    Exit Sub
'****************************************************************************
'Error Handling
 
'Handler1:
'    MsgBox "Erreur durant la première partie du programme"
'    Application.Cursor = xlDefault
'    oWB0.Close False
'    Exit Sub
 
'Handler2:
'    MsgBox "Erreur durant la deuxième partie du programme"
'    Application.Cursor = xlDefault
'    oWB0.Close False
'    oWB1.Close False
 
 
End Sub
 
Sub CommandButton2_Click() 'ANNULER
    Unload usrFrmMaj
    Exit Sub
End Sub
 
'****************************************************************************************
'Fonctions servant à cocher/décocher les enfants lorsque l'utilisateur coche/décoche les parents, merci Silkyroad
 
Private Sub TreeView1_NodeCheck(ByVal node As MSComctlLib.node)
    CocheDecoche node.Child, node.Children, node.Checked
End Sub
 
Private Sub CocheDecoche(noeud As MSComctlLib.node, NbEnfants As Integer, boolNd As Boolean)
    Dim i As Integer
    Dim xNoeud As node
    If NbEnfants = 0 Then Exit Sub
    Set xNoeud = noeud
    For i = 1 To NbEnfants
        If xNoeud.Children > 0 Then _
            CocheDecoche xNoeud.Child, xNoeud.Children, boolNd
        xNoeud.Checked = boolNd
        If i < NbEnfants Then Set xNoeud = xNoeud.Next
    Next
End Sub
 
'****************************************************************************************
'désactive la croix rouge du userForm, y'a un bouton "annuler" de toute façon
Public Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    If CloseMode = vbFormControlMenu Then Cancel = True
End Sub
 
'****************************************************************************************
'renvoit le path du fichier .xls associé à l'élément à mettre à jour ou à ajouter
Function findXLFilePath(name As String, fld0) As String
    Dim fld1 As Folder, fld2 As Folder
    Dim fl As File
    Dim foundFile As Boolean
    foundFile = False
    Application.Cursor = xlWait
    'On Error GoTo findXLFilePathHandler
    For Each fld1 In fld0.SubFolders
        If (Left(NouvNom(oFSO.GetBaseName(fld1)), 3) = Left(NouvNom(name), 3)) Then
            For Each fld2 In fld1.SubFolders
                If (Right(NouvNom(oFSO.GetBaseName(fld2)), 3) = Right(NouvNom(name), 3)) Then
                    For Each fl In fld2.Files
                        If oFSO.GetExtensionName(fl) Like "*xls" Then
                            If (Left(NouvNom(oFSO.GetBaseName(fl)), 3) = Left(name, 3)) Then
                                findXLFilePath = oFSO.GetAbsolutePathName(fl)
                                foundFile = True
                                'MsgBox "found XLFilePath"
                            End If
                        End If
                    Next fl
                End If
                If oFSO.GetBaseName(fld2) = "VIS H ISO 40144017" And foundFile = False And Left(Split(CStr(name), " ", -1)(2), 3) = "401" Then
                        findXLFilePath = "C:\Documents and Settings\mclozel\Desktop\BASE DE DONNEES COMPOSANTS MECANIQUES\MODELES\VISSERIE\VIS\VIS H ISO 40144017\VIS H ISO 40144017.xls"
                        foundFile = True
                        'MsgBox "found XLFilePath"
                        Exit Function
                End If
            Next fld2
        End If
    Next fld1
    If foundFile = False Then MsgBox "Excel file corresponding to " & name & " was not found"
    Application.Cursor = xlDefault
    Exit Function
'findXLFilePathHandler:
    'MsgBox "function findXLFilePath could not operate correctly for " & name
End Function
 
'****************************************************************************************
'donne un range (myRange) contenant les lignes d'un fichier excel correspondant au terme (name) donné en entrée, ainsi que la première ligne (debut) de ce range et la dernière ligne (fin).
Function findRange(name As String, WS As Worksheet) As cLocatedRange
    Set findRange = New cLocatedRange
    Dim nomFormate As String, tabNom() As String
    Dim i As Integer, z As Integer, trouvOcc As Boolean, colTet As Integer
            i = 1                                                           'i parcourt les lignes du fichier
        trouvOcc = False
    Application.Cursor = xlWait
    'On Error GoTo findRangeHandler
    For colTet = 1 To derCol(WS)
        If NouvNom(CStr(WS.Cells(1, colTet).Value)) = "TETON" Then Exit For  'Car les Vis STHC ISO 4028 ont soit un téton long, soit un téton court
    Next colTet
    'MsgBox colTet
    With WS
    z = apresDerLig(WS)
    While i <= z
        nomFormate = NouvNom(CStr(.Range("C" & i).Value))
        If Left(nomFormate, 3) = Left(name, 3) Then
            If Right(nomFormate, 3) = Right(name, 3) Then
                .Rows(i).Select
                If trouvOcc = False Then
                    findRange.debut = i
                    Set findRange.myRange = Selection
                    trouvOcc = True
                Else: findRange.myRange = Union(findRange.myRange, Selection)
                End If
            Else            'EXCEPTIONS : QUAND LES NOMS NE SONT PAS IDENTIQUES - essayé avec un Select Case mais me suis mal débrouillée
                tabNom = Split(nomFormate, " ", -1)
                If Right(nomFormate, 4) = "P 66" Then  'Car la norme dimensionnelle IP 66 n'apparaît pas pour les presse-étoupes ISOCAP dans les noms de dossier, mais dans base-visserie oui, car le nom est composé FAMILLE+TYPE+NORME_DIMENSIONNELLE
                    tabNom = Split(nomFormate, " ", -1) 'ok
                    If Right(tabNom(1), 3) = Right(name, 3) Then
                        'MsgBox "yep66"
                        .Rows(i).Select
                        If trouvOcc = False Then
                            findRange.debut = i
                            Set findRange.myRange = Selection
                            trouvOcc = True
                        Else: findRange.myRange = Union(findRange.myRange, Selection)
                        End If
                    Else
                        If trouvOcc = True Then
                            findRange.fin = i - 1
                            GoTo Skip
                        End If
                    End If
                Else
                    If UBound(tabNom) >= 3 Then
                        If tabNom(3) = "4028" Then
                            'MsgBox Split(name, " ", -1)(5) & " = " & NouvNom(CStr(.Cells(i, colTet).Value)) & " ?"
                            If Split(name, " ", -1)(5) = "LONG" And NouvNom(CStr(.Cells(i, colTet).Value)) = "LONG" Then
                                'MsgBox "yep2"
                                .Rows(i).Select
                                If trouvOcc = False Then
                                    findRange.debut = i
                                    Set findRange.myRange = Selection
                                    trouvOcc = True
                                Else: findRange.myRange = Union(findRange.myRange, Selection)
                                End If
                            Else
                                If Split(name, " ", -1)(5) = "COURT" And NouvNom(CStr(.Cells(i, colTet).Value)) = "COURT" Then
                                    .Rows(i).Select
                                    If trouvOcc = False Then
                                        findRange.debut = i
                                        Set findRange.myRange = Selection
                                        trouvOcc = True
                                    Else: findRange.myRange = Union(findRange.myRange, Selection)
                                    End If
                                Else
                                    If trouvOcc = True Then
                                        findRange.fin = i - 1
                                        GoTo Skip
                                    End If
                                End If
                            End If
                        Else
                            If trouvOcc = True Then
                                findRange.fin = i - 1
                                GoTo Skip
                            End If
                        End If
                    Else
                        If trouvOcc = True Then
                            findRange.fin = i - 1
                            GoTo Skip
                        End If
                    End If
                End If
            End If
        Else
            If trouvOcc = True Then
                findRange.fin = i - 1
                GoTo Skip
            End If
        End If
        i = i + 1
    Wend
Skip:
    findRange.trouve = trouvOcc
    'MsgBox findRange.trouve
    'MsgBox findRange.debut
    'MsgBox findRange.fin
'findRangeHandler:
    'MsgBox "function findRange could not operate correctly for " & name
    End With
    Application.Cursor = xlDefault
End Function
 
'************************************************************************
'blessed are the wee things
Function NouvNom(name As String) As String                              'met un nom sous une forme plus générale: pas de ponctuation, en majuscules
    Dim aRemplacer As Variant
    Dim tabname() As String
    Dim i As Integer
    aRemplacer = Array(".", "_", "`", "è", "é", "â", "-", "/", "  ")
    NouvNom = Trim(name)
    NouvNom = Replace(NouvNom, aRemplacer(0), "")
    NouvNom = Replace(NouvNom, aRemplacer(1), " ")
    NouvNom = Replace(NouvNom, aRemplacer(2), "")
    NouvNom = Replace(NouvNom, aRemplacer(3), "e")
    NouvNom = Replace(NouvNom, aRemplacer(4), "e")
    NouvNom = Replace(NouvNom, aRemplacer(5), "a")
    NouvNom = Replace(NouvNom, aRemplacer(6), "")
    NouvNom = Replace(NouvNom, aRemplacer(7), "")
    NouvNom = Replace(NouvNom, aRemplacer(8), " ")
    NouvNom = UCase(NouvNom)
End Function
 
'*************************************************************************
'Fonctions passe-partout
Function derCol(WS As Worksheet) As Integer                              'donne la dernière colonne d'une feuille, lig et col sont toutefois à adapter à la situation
    Dim lig As Integer, col As Integer
    lig = 1
    col = 1
    If IsEmpty(WS.Cells(lig, col)) Then
            derCol = col
    Else
        Do Until IsEmpty(WS.Cells(lig, col))
            col = col + 1
        Loop
        derCol = col - 1
    End If
End Function
 
Function derLigne(WS As Worksheet) As Integer                          'donne la dernière ligne d'une feuille, la valeur de i est toutefois à adapter à la situation
    derLigne = 1
    For i = 1 To WS.Columns.Count
        If (WS.Cells(Rows.Count, i).end(xlUp).Row) > derLigne Then
            derLigne = WS.Cells(Rows.Count, i).end(xlUp).Row
        End If
    Next i
End Function
 
'************************************************************************
'Fonctions peu utiles mais ayant tout de même servi
Function apresDerLig(WS As Worksheet) As Integer                        'donne l'après dernière ligne d'une feuille
    apresDerLig = derLigne(WS) + 1
End Function
 
Function apresDerCol(WS As Worksheet) As Integer                        'donne l'après dernière colonne d'une feuille
    apresDerCol = derCol(WS) + 1
End Function

Je finis mon stage ce vendredi, et j'aurais bien aimé finir au moins ça, vu que j'y suis depuis un moment, mais au pire tant pis, au moins je me serais initiée au VBA en 1 mois!

Merci pour toute indication

**many6976** · 29/08/2013, 10h03

Je me dis que c'est peut-être là que ça coince, alors au cas où:

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
Option Explicit
 
Dim oFSO As FileSystemObject
Dim oFld0 As Folder, oFld1 As Folder, oFld2 As Folder
Dim col0, col1 As Integer, i As Integer
Private TreeView1 As TreeView
Private racine As node, noeud As node, noeudFils As node
 
 
Sub ReitererAjoutDonnees()
 
    'On Error GoTo Handler
    Set oFSO = New Scripting.FileSystemObject
    Set oFld0 = oFSO.GetFolder("C:\Documents and Settings\mclozel\Desktop\BASE DE DONNEES COMPOSANTS MECANIQUES\MODELES\VISSERIE")
    Application.Cursor = xlWait
    MsgBox "Unfortunately, for as yet unknown reasons, this macro can only process one checked type at a time." & vbLf & "Please check only one type of component"
    With usrFrmMaj
 
    i = 1
    .TreeView1.Nodes.Clear
    .TreeView1.Visible = False
    Set racine = .TreeView1.Nodes.Add(, , "noeud_" & i)
    racine.Text = oFSO.GetBaseName(oFld0)
    i = 2
    For Each oFld1 In oFld0.SubFolders
        Set noeud = .TreeView1.Nodes.Add(racine, tvwChild, "noeud_" & i)
        noeud.Text = oFSO.GetBaseName(oFld1)                                        'ajout noeud parent
        i = i + 1
        For Each oFld2 In oFld1.SubFolders
            Set noeudFils = .TreeView1.Nodes.Add(noeud, tvwChild, "noeud_" & i)     'ajout noeud enfant
            noeudFils.Text = oFSO.GetBaseName(oFld2)
            i = i + 1
        Next oFld2
    Next oFld1
    .TreeView1.CheckBoxes = True
    .TreeView1.Refresh
    .TreeView1.Visible = True
    Application.Cursor = xlDefault
    .Show
    MsgBox "Processus de mise-à-jour" & vbLf & "   et d'ajout terminé"
    End With
    Exit Sub
 
'Handler:
'    MsgBox "Erreur"
'    Application.Cursor = xlDefault
 
End Sub

Sub associé à un checked treeview

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager