Construction d'une arborescence dossiers disque dans une listbox
Description
Ce code permet de visualiser l'arbre des dossiers et sous dossiers d'un disque dans une listbox. De plus il peut imprimer cet arbre.
La procédure de "listage" des dossiers (avec récursivité) n'est pas de moi.
je l'ai récupérée sur VBFrance, merci à celui qui a initié cette source.
De même que le procédure d'impression avec sauts de pages.
en fait, l'intérêt c'était de trouver une manière de donner un rendu d'arboresence correct avec un contrôle plus simple que le treeview. d'autant que ça ne sert uniquement à la visualisation.
et comme la performance c'est de faire simple,
merci à ceux qui auraient d'autres solutions (encore plus simple, mais avec le même rendu final bien sûr) de me le faire savoir...
La procédure de "listage" des dossiers (avec récursivité) n'est pas de moi.
je l'ai récupérée sur VBFrance, merci à celui qui a initié cette source.
De même que le procédure d'impression avec sauts de pages.
Source / Exemple :
Private Sub CmdList1_Click()
On Error Resume Next ''''''''''''''' attention WIN7 fichiers interdits de lecture = crash
Form1.MousePointer = 11
List1.Clear
initial = Dir1.Path
If Len(Dir1.Path) = 3 Then racine = -1 Else racine = Len(Dir1.Path)
n = -1
Do While n < List1.ListCount
Dir1.Path = List1.List(n)
For v = Dir1.ListCount - 1 To 0 Step -1
List1.AddItem Dir1.List(v), n + 1
Next v
n = n + 1
Loop
Dir1.Path = initial
For n = 0 To List1.ListCount - 1
List1.List(n) = Right(List1.List(n), Len(List1.List(n)) - (racine + 1)) 'réécriture en chemin court
Next
Form1.MousePointer = 0
CmdList2.Enabled = True
End Sub
Private Sub CmdList2_Click()
On Error Resume Next 'pour les fichiers d'accès interdits par WINDOWS 7
List2.Clear
'extrait le nom du dossier source
For a = 0 To Len(Dir1.Path) - 1
If Mid(Dir1.Path, Len(Dir1.Path) - a, 1) = "\" Then finInitialPath = Right(Dir1.Path, a): Exit For
Next
'entre sur la première ligne le nom du dossier source
List2.AddItem finInitialPath
Form1.MousePointer = 11
'----------------------------------------------------------
'construction de l'arbre
'----------------------------------------------------------
For n = 0 To List1.ListCount - 1
treeRacine = List1.List(n)
'défini le niveau de decalage en fonction de la hiérarchie
decalage = " " '4 espaces
For k = 1 To Len(treeRacine) - 1
If Mid(treeRacine, k, 1) = "\" Then decalage = decalage & " " '5 espaces
Next
'si le niveau après est inférieur à celui d'avant, insertion d'une ligne de 100 espaces
If decalage < decalageAvant Then List2.AddItem " " '100 espaces
decalageAvant = decalage
'extrait le nom du dossier final (fin du path)
For b = 0 To Len(treeRacine) - 1
If Mid(treeRacine, Len(treeRacine) - b, 1) = "\" Then
FinPath = Right(treeRacine, b)
Exit For
Else
FinPath = treeRacine
End If
Next
'ajoute la ligne d'arbre complète
List2.AddItem decalage & "|__" & FinPath
Next
'----------------------------------------------------------
'finalisation de l'arbre (génération des lignes verticales)
'----------------------------------------------------------
Dim lineDown As String
Dim lineUp As String
On Error Resume Next
For v = 0 To List2.ListCount - 1
lineDown = List2.List((List2.ListCount - 1) - v) 'lecture de la ligne du bas (on modifie les lignes de la listbox du bas vers le haut)
lineUp = List2.List((List2.ListCount - 1) - (v + 1)) 'lecture de la ligne au-dessus (celle qui doit être modifiée)
For a = 0 To Len(lineDown) - 1 'on compare chaque caractère correspondant dans les 2 lignes
If Mid(lineDown, a, 1) = "|" Then 'caractère à recopier juste au dessus de lui (dans lineUp)
If Mid(lineUp, a, 3) = " " Then 'la ligne au-dessus peut contenir 1, 2 ou 3 espaces mais probablement pas plus
If v < List2.ListCount - 1 Then
List2.List((List2.ListCount - 1) - (v + 1)) = Left(lineUp, a - 1) & "|" & Right(lineUp, Len(lineUp) - a) 'modifie la ligne au dessus
lineUp = List2.List((List2.ListCount - 1) - (v + 1)) 'la ligne au dessus a changée, donc on met à jour lineUP
End If
End If
End If
Next
Next
Form1.MousePointer = 0
End Sub
Private Sub CmdPrint_Click()
On Error GoTo fin
Dim Imprimante As String
Imprimante = cbxPrinters.Text
If Imprimante = "" Then Reponse = MsgBox("Aucune imprimante sélectionnée", 64, "V2012 - Impression de l'arborescence")
If Imprimante = "" Then GoTo fin
'Printer.TrackDefault = False ' récupère l'imprimante par défaut
Printer.Duplex = 1 ' 1=recto 2=recto/verso horizontal, 3=recto/verso vertical
Printer.PrintQuality = -1 ' -1=basse resol à -4=haute resol
Printer.PaperSize = 9 ' 9=A4, 8=A3
Printer.ColorMode = 1 ' 1=monochrome, 2=couleur)
Printer.Orientation = 1 ' 1=portrait, 2=paysage)
Printer.FontName = "arial" ' "lucida console"
Printer.FontSize = 8
Printer.FontBold = False
Printer.ScaleMode = 6 '6=mm ou vbMillimeters=mm
Printer.CurrentY = 15
P = 0
For s = 0 To List2.ListCount - 1
Printer.CurrentX = 10
If Printer.CurrentY > Printer.ScaleHeight - 25 Then 'quand ligne à 25mm du bas
Printer.Print "" '1 ligne vide de séparation
Printer.Print "" '1 ligne vide de séparation
Printer.Print "" '1 ligne vide de séparation
P = P + 1 'compteur de page
Printer.CurrentX = Printer.ScaleWidth / 2 '=10 pour avoir le numéro de page aligné sur les marges
Printer.Print "Page " & P 'imprime le N° de page
Printer.NewPage 'saute page suivante
Printer.CurrentX = 10
Printer.CurrentY = 15
End If
Printer.Print List2.List(s)
Next s
Printer.CurrentY = Printer.ScaleHeight - 15
P = P + 1 'compteur de page
Printer.CurrentX = Printer.ScaleWidth / 2 '=10 pour avoir le numéro de page aligné sur les marges
Printer.Print "Page " & P 'imprime le N° de la derniére page
Printer.EndDoc 'envoi à l'imprimante
Reponse = MsgBox(P & " pages envoyées vers : " & Imprimante, 64, "V2012 - Impression de l'arborescence")
fin:
End Sub
Private Sub Form_Load()
Dim X As Printer
For Each X In Printers
cbxPrinters.AddItem X.DeviceName
Next
'cbxPrinters.ListIndex = 0 'option
'Dir1.Path = "C:\users\JMM\desktop" 'option
'CmdList1_Click 'option
End Sub
Private Sub cbxPrinters_Click()
indexCbxPrinters = cbxPrinters.ListIndex
End Sub
Private Sub Drive1_Change()
On Error Resume Next
Dir1.Path = Drive1.Drive
Dir1.Refresh
End Sub
Private Sub Dir1_Change()
CmdList2.Enabled = False
End Sub
Conclusion :
en fait, l'intérêt c'était de trouver une manière de donner un rendu d'arboresence correct avec un contrôle plus simple que le treeview. d'autant que ça ne sert uniquement à la visualisation.
et comme la performance c'est de faire simple,
merci à ceux qui auraient d'autres solutions (encore plus simple, mais avec le même rendu final bien sûr) de me le faire savoir...
Codes Sources
A voir également
- Construction d'une arborescence dossiers disque dans une listbox
- Construction d'une pyramide france ioi ✓ - Forum Python
- Réponse examen asp construction ✓ - Forum C / C++ / C++.NET
- Listbox ✓ - Forum VB.NET
- Vba parcourir arborescence dossier ✓ - Forum Java
- Vba listbox additem ✓ - Forum Visual Basic 6
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.