Trier une liste de validation VBA

[naitgo]

Bonjour à tous,
Mes connaissance en VBA étant limitées, je n'arrive pas à trouver le code VBA qui me permettrait de trier une liste de validation générée par du VBA.
Ce code va chercher le nom des contacts dans Outlook puis affiche les informations dans différentes cellules.
Cela fait plusieurs jours que je cherche sur le forum et que je fais des essais mais rien ne fonctionne.
Quelqu'un peut-il m'aider ?
Merci d'avance pour votre aide.

Voici le code qui génère et affiche la liste de validation :

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim olApp As Outlook.Application
  Dim Cible As Outlook.ContactItem
  Dim dossierContacts As Outlook.MAPIFolder
  Dim Recherche As String
 
      If Not Target.Address = "$D$3" Then Exit Sub
 
    Set olApp = New Outlook.Application
    Set dossierContacts = _
        olApp.GetNamespace("MAPI").GetDefaultFolder(olFolderContacts)
 
    For Each Cible In dossierContacts.Items
        Resultat = Resultat & Cible.LastName & ","
    Next
 
    Range("D3").Validation.Delete
    Range("D3").Validation.Add xlValidateList, _
                Formula1:=Left(Resultat, Len(Resultat) - 1)
    Set Cible = Nothing
    Set dossierContacts = Nothing
    'olApp.Quit
    Set olApp = Nothing
 
  If Not Target.Address = "$D$3" Then Exit Sub
  On Error GoTo Fin
  Application.EnableEvents = False
  Recherche = Range("D3")
  Set olApp = New Outlook.Application
  Set dossierContacts = olApp.GetNamespace("MAPI").GetDefaultFolder(olFolderContacts)
  Set Cible = dossierContacts.Items.Find("[LastName] = '" & Recherche & "'")
  If Not Cible Is Nothing Then
    Range("G1") = Cible.CompanyName
    Range("G2") = Cible.FullName
    Range("G3") = Cible.BusinessAddressStreet
    Range("G4") = Cible.BusinessAddressPostalCode
    Range("H4") = Cible.BusinessAddressCity
    Range("G5") = Cible.Email1Address
    Sheets("Lettre").Range("F12") = Cible.Email1Address
  Else
    MsgBox "Aucun contact trouvé avec le nom : " & Recherche, vbInformation, "ATTENTION ..."
  End If
Fin:
  Application.EnableEvents = True
  Set Cible = Nothing
  Set dossierContacts = Nothing
  olApp.Quit
  Set olApp = Nothing
End Sub

 

[job75]

Re : Trier une liste de validation VBA

Bonsoir naitgo,

Pour réaliser un tri croissant de la liste, remplacer ce bloc :

For Each Cible In dossierContacts.Items
        Resultat = Resultat & Cible.LastName & ","
 Next
 
    Range("D3").Validation.Delete
    Range("D3").Validation.Add xlValidateList, _
                Formula1:=Left(Resultat, Len(Resultat) - 1)

par :

Dim s, i%, txt$
For Each Cible In dossierContacts.Items
  Resultat = Resultat & Cible.LastName & ","
Next
s = Split(Resultat, ",")
1 For i = 1 To UBound(s)
  txt = s(i)
  If LCase(txt) < LCase(s(i - 1)) Then 'tri croissant
     s(i) = s(i - 1)
     s(i - 1) = txt
     GoTo 1
  End If
Next
Resultat = Join(s, ",")
Range("D3").Validation.Delete
Range("D3").Validation.Add xlValidateList, _
  Formula1:=Resultat

A+

 

[naitgo]

Re : Trier une liste de validation VBA

Merci beaucoup Job75, le code fonctionne parfaitement, c'est exactement ce que je cherchais.
Je n'aurais jamais réussi seul à créer bloc de code.
Encore merci à toi et à tout le forum pour votre aide.
A+