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
   | Option Explicit
Dim Usf As Object
Public ChoixTree As String
 
Sub lancementProcedure()
    Dim X As Object
    Dim i As Integer
    Dim strList As String
    strList = "Monarbre"
    Set X = creationUserForm_Et_listBox_Dynamique(strList)
    X.Show
    ThisWorkbook.VBProject.VBComponents.Remove Usf
    Set Usf = Nothing
    MsgBox ChoixTree
End Sub
Function creationUserForm_Et_listBox_Dynamique(nomListe As String) As Object
    Dim objTreeview As Object
    Dim j As Integer
    Set Usf = ThisWorkbook.VBProject.VBComponents.Add(3)
    With Usf
        .Properties("Caption") = "Mon userForm"
        .Properties("Width") = 600
        .Properties("Height") = 400
        '.Name = "UsTree"
    End With
    Set objTreeview = Usf.designer.Controls.Add("MSComctlLib.TreeCtrl.2")
    objTreeview.Name = "monArbre"
    With objTreeview
        .Height = 198
        '.HideSelection = True
        .Indentation = 28.35
        .LabelEdit = 1
        .LineStyle = 0
        .MousePointer = 0
        'MonArbre.MouseIcon = 0
        .PathSeparator = "\"
        .Sorted = False
        .Style = 7
        .OLEDragMode = 0
        .OLEDropMode = 0
        .Appearance = 0
        .BorderStyle = 1
        .Enabled = True
        .Font = "Tahoma"
        .CheckBoxes = False
        .FullRowSelect = True
        .HotTracking = True
        .Scroll = True
        .SingleSel = True
        'MonArbre.ControlTipText=
        .Height = 198
        .HelpContextID = 0
        'MonArbre.InSelection = False
        .Left = 12
        .Name = "MonArbre"
        .TabIndex = 0
        .TabStop = True
        .Tag = ""
        .Top = 42
        .Visible = True
        .Width = 468
    End With
 
    Dim objButton As Object
    Set objButton = Usf.designer.Controls.Add("forms.CommandButton.1")    ', CommandButton2, Visible)
    objButton.Name = "cb_ok"
    With objButton
        .Left = 18
        .Top = 250
        .Width = 175
        .Height = 20
        .Caption = "OK"
    End With
    On Error GoTo 0
 
 
    With Usf.codeModule
        j = .countOfLines
        .insertlines j + 1, "Sub " & nomListe & "_NodeClick(ByVal Node As MSComctlLib.Node)"
        .insertlines j + 2, "msgBox Node.Key"
        .insertlines j + 3, "End Sub"
        .insertlines j + 4, " "
        .insertlines j + 5, "Private Sub UserForm_Initialize()"
        .insertlines j + 6, "call go_init (me)"
        .insertlines j + 7, "End Sub"
 
        .insertlines j + 8, "Private Sub cb_ok_Click()"
        .insertlines j + 9, "ChoixTree = MonArbre.SelectedItem"
        .insertlines j + 10, "Me.Hide"
        .insertlines j + 11, "End Sub"
    End With
    VBA.UserForms.Add (Usf.Name)
    Set creationUserForm_Et_listBox_Dynamique = UserForms(UserForms.Count - 1)
End Function
 
Sub go_init(my_userform As UserForm)
 
 
    Dim CeFichier, O, W, Fenetre, F
 
    'VBA.UserForms("UserForm1").Show
 
    Dim tw As MSComctlLib.TreeView
    Set tw = my_userform.Controls.Item("MonArbre")
 
    Dim feuille As Worksheet
 
    ' Set tw = Me.monArbre
    Set CeFichier = ThisWorkbook
    'tw.Nodes.Add(noeud_père,twchild,création_noeud_courant,libellé_noeud)
    tw.Nodes.Add(, , "NoeudInit", "Fenêtres").Expanded = True    ' Racine arbre
 
    O = 0
    '-- FICHIERS
    For W = 1 To Application.Windows.Count
 
        Fenetre = Application.Windows.Item(W).Caption
 
        If CeFichier.Name = Fenetre Then GoTo W_suivant
        If Windows(Fenetre).Visible = True Then
            tw.Nodes.Add("NoeudInit", tvwChild, "NoeudDep" & W, Fenetre).Expanded = False
            '--- Onglets
            For F = 1 To Workbooks(Fenetre).Sheets.Count
                O = O + 1
                Set feuille = Workbooks(Fenetre).Sheets(F)
                If feuille.Visible = True Then
                    tw.Nodes.Add("NoeudDep" & W, tvwChild, "NoeudMat" & O, feuille.Name).Expanded = True
                End If
            Next F
        End If
W_suivant:
 
    Next W
End Sub | 
Partager