Avec ce treeview, vous pouvez ajouter, modifier, supprimer, déplacer,imprimer et enregistrer vos données d'une façon simple avec visualisation préalable.
Une gestion des icônes à partir d'un contrôle imagelist vous permet aussi de les modifier.
Source / Exemple :
Dim numfich As Integer
Dim savefic()
Dim tvdrag As Boolean
Dim nodX As Node
Sub nouveaufichier()
chemin = ""
Tv.Nodes.Clear
fnom = "nouveau"
Tv.Nodes.Add , , , fnom, 1, 1 'affichage par defaut
Toolbarmenu.Buttons(2).ToolTipText = "Enregistrer "
End Sub
Sub fermeture()
Dim ret
'demande d 'enregistrement en cas de modifications à la fermeture ou au changement de liste
If okaychange = True Then
okaychange = False
ret = MsgBox("Enregistrez les modifications ? ", vbYesNo + vbQuestion, "Enregistrement")
If ret = 7 Then Exit Sub
Call listeàenregistrer
Call enregistrement(chemin)
End If
End Sub
Sub deplacetree(orignode As Node, destnode As Node)
On Error Resume Next
Dim cs As Long, nn, mm
Dim i As Integer
i = i + 1
Tv.Nodes.Add destnode.Key, tvwChild, destnode.Key & "\" & orignode.Text, orignode.Text, orignode.Image, orignode.Image
cs = orignode.Children
If cs > 0 Then
nn = orignode.Child.Key
mm = Tv.Nodes(destnode.Key & "\" & orignode.Text).Key
j = 1
Do
deplacetree Tv.Nodes(nn), Tv.Nodes(mm)
If j < cs Then
nn = orignode.Child.Key
j = j + 1
Else
Exit Do
End If
Loop
End If
Tv.Nodes.Remove orignode.Key
End Sub
Sub chargeimages()
Dim folder, f1, s, fc
'
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(App.Path & "\liste_image")
Set fc = folder.Files
For Each f1 In fc
Image1.ListImages.Add , f1.Name, LoadPicture(folder & "\" & f1.Name)
Next
End Sub
Sub boiteouverture()
On Error GoTo ErrHandler 'si click sur annuler
CommonDialog1.InitDir = App.Path 'chemin par défaut ou se lance le logiciel
CommonDialog1.CancelError = True ' initialise la valeur d'erreur
CommonDialog1.DialogTitle = "Ouvrir un tree view"
CommonDialog1.Filter = "Tous les fichiers (*.*)|*.*| Fichiers texte""(*.txt)|*.txt"
CommonDialog1.FilterIndex = 2 'filtre sur texte
CommonDialog1.ShowOpen 'boite ouvrir
chemin = CommonDialog1.FileName
Exit Sub
ErrHandler:
erreurouverture = True
If Err.Number = 32755 And chemin = "" Then 'si annuler activé et chemin vide
MsgBox Err.Description & vbLf & "un nouveau projet va être affiché", vbInformation
mnulignesenregistrer.Enabled = False
Call nouveaufichier
End If
If Err.Number = 35601 Then 'si fichier non conforme
MsgBox Err.Description
Frame2.Visible = False
mnulignesenregistrer.Enabled = False 'on inhibe la liste complète
mnuliste.Enabled = False 'on inhibe la liste de sauvegarde
mnuenregistrer.Enabled = False 'inhibition menu enregistrer
mnusous.Enabled = False 'inhibition menu enregistrer sous
mnutitre.Enabled = False ' inhibition menu ajouter un titre
mnusupsel.Enabled = False 'inhibition menu supprimer
Exit Sub
End If
End Sub
Sub chargetv1()
Dim i As Long
'charge la nouvelle liste
tv1.Nodes.Clear
For i = 1 To Image1.ListImages.Count
tv1.Nodes.Add , , , Image1.ListImages(i).Key, Image1.ListImages(i).Key
Next
End Sub
Public Sub listeàenregistrer()
Dim lig As Integer
ReDim savefic(500)
For lig = 1 To Tv.Nodes.Count
If Tv.Nodes(lig).Parent Is Nothing Then
savefic(lig) = Tv.Nodes(lig).FullPath & "," & Tv.Nodes(lig).Text & "," & Tv.Nodes(lig).Image & "," & Tv.Nodes(lig).SelectedImage
Else
savefic(lig) = Tv.Nodes(lig).Parent.FullPath & "," & Tv.Nodes(lig).Text & "," & Tv.Nodes(lig).Image & "," & Tv.Nodes(lig).SelectedImage
End If
Next lig
DoEvents
End Sub
Sub affichagelistesauvegarde()
For lig = 1 To Form1.Tv.Nodes.Count
If Form1.Tv.Nodes(lig).Parent Is Nothing Then
'affichage raçine
Liste.List1.AddItem Form1.Tv.Nodes(lig).FullPath & "," & Form1.Tv.Nodes(lig).Text & "," & Form1.Tv.Nodes(lig).Image & "," & Form1.Tv.Nodes(lig).SelectedImage
Else
Liste.List1.AddItem Form1.Tv.Nodes(lig).Parent.FullPath & "," & Form1.Tv.Nodes(lig).Text & "," & Form1.Tv.Nodes(lig).Image & "," & Form1.Tv.Nodes(lig).SelectedImage
End If
Next lig
Liste.Caption = "Liste d'enregistrement"
Liste.Show
End Sub
Public Sub sauve_sous()
On Error GoTo ErrHandler 'si click sur annuler
Dim lig As Integer
numfich = FreeFile
'
CommonDialog1.InitDir = App.Path 'chemin du dossier d'ouverture
CommonDialog1.CancelError = True ' initialise la valeur d'erreur
CommonDialog1.DialogTitle = "sauve un tree view"
CommonDialog1.Filter = "Tous les fichiers (*.*)|*.*| Fichiers texte""(*.txt)|*.txt"
CommonDialog1.FilterIndex = 2 'filtre sur txt par défaut
CommonDialog1.Flags = &H2 'si le fichier à remplacer existe
CommonDialog1.FileName = chemin 'nom du fichier à sauvegarder avec chemin
CommonDialog1.ShowSave 'affichage boite de sauvegarde
'
Call listeàenregistrer
Call enregistrement(CommonDialog1.FileName)
Toolbarmenu.Buttons(2).ToolTipText = "Enregistrer " & chemin
Exit Sub
ErrHandler:
Exit Sub
End Sub
Private Sub cmdmemento_Click()
If Lbl1.Visible = True Then
Lbl1.Visible = False
Lbl2.Visible = True
cmdmemento.Caption = "<"
Exit Sub
Else
Lbl2.Visible = False
Lbl1.Visible = True
cmdmemento.Caption = ">"
End If
End Sub
Private Sub Form_Load()
Form1.Width = 600 * Screen.TwipsPerPixelX 'largeur feuille
Form1.Height = 550 * Screen.TwipsPerPixelY 'hauteur feuille
Form1.Show 'affiche la feuille
erreurouverture = False
Tv.ImageList = Image1 'affecte l'objet image au treeview
tv1.ImageList = Image1 'affecte l'objet image au treeview de gestion des images
Call chargeimages 'charge imagelist avec les images du dossier liste_image
Call boiteouverture 'ouvre la boite de sélection de fichier
Call ouverture 'charge le treeview
okaychange = False
DoEvents
End Sub
Private Sub Form_Resize()
'redimensionne le treeview
Tv.Move 5, Toolbarmenu.Height, (Form1.Width), (Form1.Height - sb1.Height)
End Sub
Public Sub ouverture()
On Error GoTo errouverture
If chemin = "" Then Exit Sub
Frame2.Visible = True 'affiche le texte de chargement
LockWindowUpdate Tv.hwnd
Tv.Nodes.Clear 'vide le treeview
numfich = FreeFile
Open chemin For Input As #numfich
While Not EOF(numfich)
Input #numfich, fchemin 'clé du noeud parent
Input #numfich, fnom 'texte du noeud
Input #numfich, fimage 'image
Input #numfich, fimagesel 'imagesélectionnée
'racine
If fchemin = fnom Then
Tv.Nodes.Add , , fnom, fnom, fimage, fimagesel 'noeud raçine
Else
Tv.Nodes.Add fchemin, tvwChild, fchemin & "\" & fnom, fnom, fimage, fimagesel 'noeud dépendant
End If
DoEvents
Wend
Close
Tv.Nodes(1).Expanded = True 'affiche les dossiers
Frame2.Visible = False 'chargement en cours...
sb1.Panels(1).Text = Tv.Nodes.Count & " noeuds" 'nombre de lignes
Form1.Caption = CommonDialog1.FileName 'nom du fichier à la feuille
' enabled des menus
mnuliste.Enabled = True
mnulignesenregistrer.Enabled = True
mnuenregistrer.Enabled = True
mnusous.Enabled = True
mnutitre.Enabled = True
mnusupsel.Enabled = True
Call listefullpath
Tv.Nodes(1).Selected = True
DoEvents
LockWindowUpdate 0& 'affiche la fenetre
Toolbarmenu.Buttons(2).ToolTipText = "Enregistrer " & chemin
Exit Sub
' gestion des erreurs si l'image n'existe pas
errouverture:
If Err.Number = 35601 Then
fimage = "img1"
fimagesel = "img1"
Resume
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
Call fermeture
End Sub
Private Sub mnuaide_Click()
frmaide.Show 1
End Sub
Private Sub mnuapropos_Click()
frmAbout.Show 1
End Sub
Private Sub mnuchercher_Click()
frecherche.Show 1 'ouvre la feuille de recherche
End Sub
Private Sub mnuedition_Click()
mnusoustitre.Caption = "Ajouter un sous-titre à " & Tv.SelectedItem.Text
End Sub
Private Sub mnuenregistrer_Click()
Call sauve
End Sub
Private Sub mnufermearbre_Click()
'ferme tous les noeuds ouverts
For i = 1 To Tv.Nodes.Count
Tv.Nodes.Item(i).Expanded = False
Next
End Sub
Private Sub mnufermer_Click()
Unload Me
End Sub
Private Sub mnuimage_Click()
'gestion des images
Toolbarmenu.Buttons(5).Value = tbrPressed
Frame1.Visible = True
Frameaide.Visible = False
End Sub
Private Sub mnulignesenregistrer_Click()
'affichage des lignes complètes
Dim i As Integer
i = 1
While fic(i) <> ""
Liste.List1.AddItem fic(i)
i = i + 1
Wend
Liste.Caption = "Lignes entières de l'arborescence"
Liste.Show 1
End Sub
Private Sub mnuliste_Click()
'affiche la liste de sauvegarde
Call affichagelistesauvegarde
End Sub
Private Sub mnunouveau_Click()
Call fermeture
Call nouveaufichier
End Sub
Private Sub mnuouvrearbre_Click()
'ouvre tous les noeuds du treeview
For i = 1 To Tv.Nodes.Count
Tv.Nodes.Item(i).Selected = True
Next
End Sub
Private Sub mnuouvrir_Click()
' ouverture d'un nouveau fichier
Call fermeture
Call boiteouverture
DoEvents
Call ouverture
End Sub
Private Sub mnusous_Click()
'enregistrement sous un nouveau nom
Call sauve_sous
End Sub
Private Sub mnusoustitre_Click()
'insère un sous titre dans l'arborescence
Set nodX = Tv.Nodes.Add(Tv.SelectedItem, tvwChild, , "Sous-titre", 1, 1)
nodX.EnsureVisible
okaychange = True
End Sub
Private Sub mnusupsel_Click()
Dim ret As Integer
'efface le noeud sélectionné
ret = MsgBox("Supprimer réellement " & Tv.Nodes(Tv.SelectedItem.Index), vbYesNo + vbQuestion, "Supprimer un enregistrement")
If ret = 7 Then Exit Sub
Tv.Nodes.Remove (Tv.SelectedItem.Index)
okaychange = True
End Sub
Private Sub mnutitre_Click()
'insère un titre dans l'arborescence
Set nodX = Tv.Nodes.Add(, , , "Titre", 1, 1)
nodX.EnsureVisible
okaychange = True
End Sub
Private Sub Toolbarmenu_ButtonClick(ByVal Button As MSComctlLib.Button)
Dim lig As Integer
Select Case Button.Index
Case 1 'ouvrir
Call fermeture
Call boiteouverture
DoEvents
Call ouverture
Case 2 'sauve
Call sauve
Case 3 'fermer
Unload Me
Case 5 'gestion image
If Button.Value = tbrPressed Then
' Frame1.Move Frameaide.Left, Frameaide.Top, Frameaide.Width, Frameaide.Height
Formimage.Left = Form1.Left + (Form1.Width / 2)
Formimage.Top = Form1.Top
form1active = True
Formimage.Show
' Frame1.Visible = True
' Frameaide.Visible = False
Else
Unload Formimage
' Frame1.Visible = False
' Frameaide.Visible = True
imdrag = False
End If
Case 6 'rechercher
frecherche.Show 1
Case 8 'arborescence
If Button.Value = tbrPressed Then
'ouvre tous les noeuds du treeview
For i = 1 To Tv.Nodes.Count
Tv.Nodes.Item(i).Selected = True
Next
Else
'ferme tous les noeuds ouverts
For i = 1 To Tv.Nodes.Count
Tv.Nodes.Item(i).Expanded = False
Next
End If
Case 9 'liste
Call affichagelistesauvegarde
End Select
End Sub
Private Sub Tv_AfterLabelEdit(Cancel As Integer, NewString As String)
okaychange = True 'variable d'enregistrement sur vrai si modification étiquette
End Sub
Private Sub Tv_DragDrop(Source As Control, x As Single, y As Single)
If imdrag = True Then Exit Sub
If Tv.DropHighlight Is Nothing Then GoTo suite
If nodX Is Nothing Then GoTo suite 'si noeud vide
If nodX = Tv.DropHighlight Then GoTo suite 'si noeud est le meme
Call deplacetree(nodX, Tv.DropHighlight)
Set Tv.DropHighlight = Nothing
tvdrag = False
okaychange = True
Exit Sub
suite:
Set Tv.DropHighlight = Nothing
tvdrag = False
End Sub
Private Sub Tv_DragOver(Source As Control, x As Single, y As Single, State As Integer)
On Error Resume Next
If tvdrag = True Then
Set Tv.DropHighlight = Tv.HitTest(x, y)
Tv.DragIcon = Tv.SelectedItem.CreateDragImage
End If
End Sub
Private Sub Tv_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = 1 Then
Set nodX = Tv.HitTest(x, y)
End If
'affiche le menu contextuel
If Button = 2 Then
mnusupsel.Caption = "Supprimer " & Tv.SelectedItem
PopupMenu mnuedition
End If
End Sub
Private Sub Tv_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = 1 Then
tvdrag = True
Tv.Drag vbBeginDrag 'initialise le dragdrop
End If
End Sub
Private Sub Tv_NodeClick(ByVal Node As MSComctlLib.Node)
'ouvre ou ferme le noeud cliqué
Node.Expanded = Not Node.Expanded
sb1.Panels(2).Text = Node.FullPath
If form1active = True Then
Formimage.tvimg.Nodes.Clear
DoEvents
Formimage.Textimg.Text = Node.FullPath
Formimage.tvimg.Nodes.Add , , , Tv.SelectedItem.Image, Tv.SelectedItem.Image
Formimage.tvimg.Nodes.Add , , , Tv.SelectedItem.SelectedImage, Tv.SelectedItem.SelectedImage
End If
End Sub
Public Sub enregistrement(nomfichier)
Dim lig As Integer
numfich = FreeFile
lig = 1
Open nomfichier For Output As #numfich
While savefic(lig) <> ""
'sauvegarde du noeud clé parent et du texte du noeud
Print #numfich, savefic(lig)
DoEvents
lig = lig + 1
Wend
Close
chemin = nomfichier
Form1.Caption = chemin
okaychange = False
End Sub
Public Sub listefullpath()
'liste les lignes d'enregistrement
ReDim fic(500)
Dim i, n As Integer
n = 1
For i = 1 To Tv.Nodes.Count 'lecture de chaque noeud du treeview
If Tv.Nodes(i).Children Then 'si enfant existe on continue
Else
fic(n) = Tv.Nodes(i).FullPath 'sinon on ecrit la ligne complète
n = n + 1
End If
Next
sb1.Panels(3).Text = n - 1 & " Enregistrement(s)"
End Sub
Private Sub tv1_DragDrop(Source As Control, x As Single, y As Single)
tv1.DropHighlight = Nothing
tv1.Drag vbEndDrag 'initialise le dragdrop
imdrag = False
End Sub
Private Sub tv1_DragOver(Source As Control, x As Single, y As Single, State As Integer)
If State = 0 Then Source.DragIcon = LoadPicture(App.Path & "\liste_image\rat.ico")
If imdrag = True Then
tv1.DragIcon = tv1.SelectedItem.CreateDragImage 'icone de l'image sélectionnée
End If
End Sub
Private Sub tv1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
If tv1.Nodes.Count = 0 Then Exit Sub
Set imgx = tv1.HitTest(x, y) 'variable de l'image sélectionnée
End Sub
Private Sub tv1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
If tv1.Nodes.Count = 0 Then Exit Sub 'si des images existent dans le treeview
If Button = vbLeftButton Then
tv1.Drag vbBeginDrag 'initialise le dragdrop
imdrag = True
End If
End Sub
Private Sub tvimg_DragDrop(Source As Control, x As Single, y As Single)
If tvimg.DropHighlight Is Nothing Then
Set tvimg.DropHighlight = Nothing
imdrag = False
Exit Sub
Else
If tvimg.DropHighlight.Index = 1 Then
Tv.SelectedItem.Image = tv1.SelectedItem.Image
tvimg.DropHighlight.Image = tv1.SelectedItem.Image
okaychange = True
End If
If tvimg.DropHighlight.Index = 2 Then
Tv.SelectedItem.SelectedImage = tv1.SelectedItem.Image
tvimg.DropHighlight.Image = tv1.SelectedItem.Image
okaychange = True
End If
Set tvimg.DropHighlight = Nothing
End If
End Sub
Private Sub tvimg_DragOver(Source As Control, x As Single, y As Single, State As Integer)
If imdrag = True Then
Set tvimg.DropHighlight = tvimg.HitTest(x, y)
End If
End Sub
Private Sub tvimg_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
imdrag = False
End Sub
Public Sub sauve()
If chemin = "" Then 'si le chemin est vide on dirige vers enregistrer_sous
Call sauve_sous
Exit Sub
End If
' sauve vers tableau
Call listeàenregistrer
Call enregistrement(chemin)
End Sub
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.