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
| Option Explicit
Option Compare Text
Dim maPageHtml As HTMLDocument
Private Sub UserForm_Initialize()
Dim NumCol As Integer, j As Integer
Dim NumLig As Integer, k As Integer
Dim Cell As Range
Dim Image1 As String, Image2 As String
'--- Spécifie les images qui s'affichent dans les noeuds.
'Les images doivent être dans le même répertoire que le classeur.
Image1 = ThisWorkbook.Path & "\redball.gif"
Image2 = ThisWorkbook.Path & "\grnarrow.gif"
'Supprime le contenu de l'ImageList
Me.ImageList1.ListImages.Clear
'chargement des images
Me.ImageList1.ListImages.Add 1, "Img1", LoadPicture(Image1)
Me.ImageList1.ListImages.Add 2, "Img2", LoadPicture(Image2)
'Associe les images au TreeView
Set Me.TreeView1.ImageList = Me.ImageList1
'---
'Boucle sur les éléments de la Structure pour remplir le TreeView
For Each Cell In Sheets("Structure").Range("A1:A" & Sheets("Structure").Range("N65533").End(xlUp).Row)
NumCol = Cell.End(xlToRight).Column
NumLig = Cell.Row
If NumCol = 2 Then
TreeView1.Nodes.Add , , "maClé" & NumLig & NumCol, _
UCase(Sheets("Structure").Cells(NumLig, NumCol)), "Img1", "Img1"
Else
k = Sheets("Structure").Cells(NumLig, NumCol).Offset(0, -1).End(xlUp).Row
j = Sheets("Structure").Cells(NumLig, NumCol).Offset(0, -1).Column
'S'il s'agit d'un membre de l'équipe:
'(Dans ce cas la colonne N contient la lettre "x")
If Sheets("Structure").Cells(NumLig, 14) = "x" Then
TreeView1.Nodes.Add _
"maClé" & k & j, tvwChild, "maClé" & NumLig & NumCol, _
Sheets("Structure").Cells(NumLig, NumCol), "Img2", "Img2"
Else
'S'il s'agit d'un titre de service:
TreeView1.Nodes.Add _
"maClé" & k & j, tvwChild, "maClé" & NumLig & NumCol, _
UCase(Sheets("Structure").Cells(NumLig, NumCol)), "Img1", "Img1"
End If
End If
Next Cell
TreeView1.Style = 5
End Sub
Private Sub UserForm_Activate()
'Pour afficher l'UserForm en plein écran
'With Me
'.StartUpPosition = 3
'.Width = Application.Width
'.Height = Application.Height
'.Left = 0
'.Top = 0
'End With
End Sub
'Déploie l'ensemble du TreeView si la checkBox
'"Déployer la totalité de l'arborescence" est cochée.
Private Sub CheckBox1_Click()
Dim i As Byte
If CheckBox1 Then
'Boucle sur tous les noeuds du TreeView.
For i = 1 To TreeView1.Nodes.Count
TreeView1.Nodes.Item(i).Expanded = True
Next
Else
For i = 1 To TreeView1.Nodes.Count
TreeView1.Nodes.Item(i).Expanded = False
Next
End If
'Positionne le 1er noeud dans la partie visible du TreeView
TreeView1.Nodes.Item(1).EnsureVisible
End Sub
'Evenement Clic sur un élément du treeView.
Private Sub TreeView1_Click()
Dim leNom As String, Fichier As String
'Vérifie si l'élément sélectionné correspond à une personne ou à un titre
'de service.
'(La colonne N contient la lettre "x" s'il s'agit d'une personne)
If Sheets("Structure").Cells(TreeView1.SelectedItem.Index, 14) <> "" Then
'Affiche les informations sur la personne sélectionnée.
Label2 = TreeView1.SelectedItem.Text
Label3 = "Téléphone : " & Sheets("Structure").Cells(TreeView1.SelectedItem.Index, 15)
Label4 = "Fax : " & Sheets("Structure").Cells(TreeView1.SelectedItem.Index, 16)
Label5 = "Fonction : " & TreeView1.SelectedItem.parent
leNom = TreeView1.SelectedItem.Text
'Définit l'image associée au nom sélectioné.
Fichier = ThisWorkbook.Path & "\" & leNom & ".jpg"
'Vérifie si le fichier image existe dans le répertoire
If Dir(Fichier) <> "" Then
'Charge l'image si elle existe.
Image1.Picture = LoadPicture(Fichier)
Else
'Sinon fait le ménage dans le contrôle Image
Set Image1.Picture = Nothing
End If
End If
End Sub |
Partager