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 :
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 :
Code:
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