• La Zone de liste (ListBox) affiche une liste dans laquelle un ou plusieurs éléménts peuvent être séléctionnés. Une barre de défilement est ajoutée automatiquement si tous les éléments ne peuvent être affichés simultanément.
  L'utilisateur ne peut rien ajouter dans une zone de liste.


• La Liste modifiable (ComboBox) combine une zone de texte et une zone de liste. L'utilisateur peut saisir un nouvel élément dans la zone de texte ou sélectionner un élément dans la zone de liste.
  Il est possible d'interdire la saisie de nouveaux éléments.

• Lire un élément de la liste : strElement = lstBoite.List(intIndex)


• Modifier un élément de la liste : lstBoite.List(intIndex) = strElement


• Nombre d'éléments de la liste : intNbre = lstBoite.ListCount


• Index de l'élément sélectionné dans la liste : intIndex = lstBoite.ListIndex
  Attention, l'index commence à zéro. Le 3ème élément d'une liste aura pour index '2'.


• Ajouter un élément dans la liste : lstBoite.AddItem "Nouvel élément" [, index]
  L'index définit la position dans la liste et est optionnel.


• Retirer un élément de la liste : lstBoite.RemoveItem(intIndex)
  Exemple lstBoite.RemoveItem(1) supprime le 2ème élément de la liste.


• Supprimer tous éléments de la liste : lstBoite.clear

• Une première zone de liste qui récupère et affiche la liste des calques.
• La seconde partie affiche dans une ComboBox une liste récupérée dans un fichier texte.
• La dernière partie affiche dans une autre ComboBox une colonne d'un fichier Excel.

• On conserve le nom UserForm1

• Cette routine s'exécute automatiquement au lancement de la feuille
• La liste lstCalques est crée avec la méthode AddItem
• Déclaration des nom et répertoires par défaut des fichiers utilisés dans les 2 autres parties. A personnaliser !

Private Sub UserForm_Initialize()
  Dim objCalque As AcadLayer
  For Each objCalque In ThisDrawing.Layers
    lstCalques.AddItem objCalque.Name
  Next
  txtNomFich.Text = "d:\vbatest\listest.txt"
  txtNomExcel.Text = "d:\vbatest\test3.xls"
End Sub

• Ce bouton n'a que pour seul but de vérifier la valeur de retour de l'élément choisi
• La propriété ListIndex donne l'index de l'élément sélectionné.
  S'il est égal à -1, il n'y a rien de sélectionné.
• Sinon une boîte de dialogue donne l'index de l'élément choisi suivi de sa valeur.

Private Sub cmdCalqueSel_Click()
    Dim strCalque As String
    selection% = lstCalques.ListIndex
    If selection% = -1 Then
        MsgBox "Aucun calque n'a été sélectionné !", vbCritical
    Else
        strCalque = lstCalques.List(selection%)
        MsgBox "Le calque Index N°" & selection% & " - Nom : " & strCalque & " a été sélectionné"
    End If
End Sub

• Ce bouton permet de retirer le calque 0 de la liste des calques
• On recherche d'abord l'index de l'élément à supprimer, puis
• La méthode RemoveItem permet de supprimer l'élément correspondant à l'index.
  

Private Sub cmdCalque0_Click()
    For Cpt1% = 0 To lstCalques.ListCount - 1
        If lstCalques.List(Cpt1%) = "0" Then
            lstCalques.RemoveItem Cpt1%
            MsgBox "Calque 0 enlevé de la liste"
            Exit Sub
        End If
    Next Cpt1%
    MsgBox "Calque 0 déjà enlevé !"
End Sub

• Ce bouton permet de trier la liste par ordre alphabétique.
• La propriété sorted (trié) n'existant pas en VBA, on fait appel à une fonction que l'on place dans module1 - Voir plus loin.

Private Sub cmdTri1_Click()
    lstCalques = Tri_Liste(lstCalques)
End Sub
 

• Ce bouton permet de Quitter cet exercice.

Private Sub cmdQuitter_Click()
    Unload Me
End Sub
  

• Option Explicit oblige à déclarer les variables, ce qui permet de réduire les conséquences des fautes de frappe.
• Public : les valeurs de ces variables sont utilisées dans plusieurs procédures.
• La pocédure Listes sert à lancer le programme.
  
• La fonction Tri_Liste permet le tri d'une liste sans éléments identiques..
  
• La fonction ExtractFichier sert à extraire une liste d'un fichier texte (2ème partie).
  

Option Explicit

Public Sub Listes()
   UserForm1.Show
End Sub

'********** Function Tri_Liste **********************************
' Objet  :  Tri une liste d'éléments d'une liste par
'           ordre alphabétique croissant
' Entrée :  lstA_Trier  : la liste des éléments à trier
' Retour :  La liste triée
'*****************************************************************
Public Function Tri_Liste(lstA_Trier)

    Dim intIndex() As Integer   ' index des éléments de la liste
    Dim Cpt1, Cpt2 As Integer   ' compteurs
    ReDim lstOriginale(lstA_Trier.ListCount - 1) As String
    ReDim intIndex(lstA_Trier.ListCount - 1) As Integer

    For Cpt1 = 0 To lstA_Trier.ListCount - 1
        lstOriginale(Cpt1) = lstA_Trier.List(Cpt1)
    Next Cpt1

    For Cpt1 = LBound(lstOriginale) To UBound(lstOriginale)
      For Cpt2 = LBound(lstOriginale) To UBound(lstOriginale)
         If lstOriginale(Cpt1) > lstOriginale(Cpt2) Then _
              intIndex(Cpt1) = intIndex(Cpt1) + 1
      Next Cpt2
    Next Cpt1

    For Cpt1 = LBound(lstOriginale) To UBound(lstOriginale)
         lstA_Trier.AddItem lstOriginale(Cpt1), intIndex(Cpt1)
         lstA_Trier.RemoveItem intIndex(Cpt1) + 1
    Next Cpt1
End Function

'********** Function ExtractFichier ******************************
' Objet  :  Extrait une liste d'un fichier texte
' Notes  :  - Chaque ligne devient un élément de la liste
'        :  donc un seul élément par ligne !
'        :  - On peut donner n'importe quelle extension au fichier,
'        :  du moment que c'est un fichier texte.
' Entrées:  NomFich : Nom du fichier texte avec son chemin complet
'        :  Liste   : Le nom de liste
' Retour :  La liste
'*****************************************************************

Public Function ExtractFichier(NomFich As String, Liste)
    Dim FNum As Integer         ' numero de fichier
    Dim Texte As String         ' la ligne extraite
    On Error Resume Next
     ' FreeFile renvoie le prochain numéro de fichier disponible
    FNum = FreeFile()
    ' ouverture du fichier en lecture, accès partagé
    Open NomFich For Input Access Read Shared As FNum
    If Err <> 0 Then
        MsgBox "Impossible d'ouvrir le fichier '" & NomFich & "' !"
        Exit Function
    End If
    ' Lecture de chaque ligne et ajout dans la liste
    Do While Not EOF(FNum)
        Line Input #FNum, Texte
        Liste.AddItem Texte
    Loop
    Close #FNum
End Function

• Cette routine vérifie par Dir$ si le fichier indiqué dans la zone de texte existe bien.
• Ensuite vide la liste par la méthode clear dans le cas ou on appelle plusieurs fois cette routine.
• On exécute la fonction ExtractFichier pour récupérer la liste.

Private Sub cmdExtraire_Click()
    ' Bouton de commande de l'extraction d'un fichier texte
        
    If Dir$(txtNomFich.Text) = "" Then
       MsgBox "ATTENTION : le fichier de données n'existe pas !", 16
       Exit Sub
    End If
    cboFichier.Clear
    cboFichier = ExtractFichier(txtNomFich.Text, cboFichier)
End Sub

• Ce bouton permet de trier la liste par ordre alphabétique.

Private Sub cmdTri2_Click()
    cboFichier = Tri_Liste(cboFichier)
End Sub
 

• Ce bouton donne la valeur de l'élément sélectionné..

Private Sub cmdFichSel_Click()
    Dim strFich As String
    selection% = cboFichier.ListIndex
    If selection% = -1 Then
        If Trim(cboFichier.Text) <> "" Then
            strFich = cboFichier.Text
            MsgBox "L'élément : " & strFich & " a été sélectionné"
        Else
            MsgBox "Aucun élément n'a été sélectionné !", vbCritical
        End If
    Else
        strFich = cboFichier.List(selection%)
        MsgBox "L'élément : " & strFich & " a été sélectionné"
    End If
End Sub
 

• Cette routine vérifie par Dir$ si le fichier indiqué dans la zone de texte existe bien.
• Ensuite vide la liste par la méthode clear dans le cas ou on appelle plusieurs fois cette routine.
• On ouvre l'application Excel et le fichier .xls
• On extrait chaque cellule de la colonne désirée par la méthode AddItem.

Private Sub cmdExtrExcel_Click()
    Dim AppExcel As Object       ' Variable objet Application Excel
    Dim FeuilleXL As Object
    Dim intRangee As Integer
    Dim blnRang As Boolean
    
     ' on récupère le nom du fichier
    If Dir$(txtNomExcel.Text) = "" Then
       MsgBox "ATTENTION : le fichier Excel n'existe pas !", 16
       Exit Sub
    End If
    cboExcel.Clear
    
    On Error Resume Next
    ' Ouvre le fichier Excel
    Set AppExcel = GetObject(txtNomExcel.Text)
    ' Sinon il y a une erreur
    If Err <> 0 Then
        MsgBox "Impossible d'ouvrir le fichier '" & txtNomExcel.Text & "' !"
        Exit Sub
    End If
    ' Entrez ici le nom de la feuille
    Set FeuilleXL = AppExcel.Worksheets("Calques")
    If Err <> 0 Then
        MsgBox "Impossible d'ouvrir la feuille 'Calques' !"
        Exit Sub
    End If
    'Desactivation du gestionnaire d'erreur
    On Error GoTo 0
    intRangee = 2          ' rangée de départ
    blnRang = True         ' drapeau cellule non vide
    While blnRang = True
        intRangee = intRangee + 1
        If FeuilleXL.Cells(intRangee, 1) = "" Then		'  colonne 1
            blnRang = False
        Else
             cboExcel.AddItem FeuilleXL.Cells(intRangee, 1) 	'  colonne 1
        End If
    Wend
 End Sub

• Ce bouton permet de trier la liste par ordre alphabétique.

Private Sub cmdTri3_Click()
    cboExcel = Tri_Liste(cboExcel)
End Sub
 

• Ce bouton donne la valeur de l'élément sélectionné..

Private Sub cmdExcelSel_Click()
    Dim strFich As String
    selection% = cboExcel.ListIndex
    If selection% = -1 Then
        MsgBox "Aucun élément n'a été sélectionné !", vbCritical
    Else
        strFich = cboExcel.List(selection%)
        MsgBox "L'élément : " & strFich & " a été sélectionné"
    End If
End Sub