Bonjour à tous,
Cela fait deux jours que je cherche une solution à mon problème, mais je ne vois pas ce qui ne fonctionne pas.
J'ai un code qui génère une liste de validation qui va chercher le nom des contacts dans Outlook et qui fonctionne très bien lorsqu'il est seul sur feuille de classeur.
Donc, je l'ai intégré sur une feuille d'un autre classeur, mais lorsque j'ajoute ou que je supprime un contact dans Outlook, la liste de validation ne se met pas à jour, alors qu'elle se met à jour lorsque le code est seul sur une feuille dans un autre classeur. Pour moi, le code est tout à fait identique, alors je ne vois pas où est le problème.
Quelqu'un peut-il m'aider à résoudre cette énigme ?
D'avance je vous remercie pour votre aide.
Voici le code qui se trouve seul sur une feuille :
et voici le même code compilé avec un autre code et c'est là que ça coince :
Cela fait deux jours que je cherche une solution à mon problème, mais je ne vois pas ce qui ne fonctionne pas.
J'ai un code qui génère une liste de validation qui va chercher le nom des contacts dans Outlook et qui fonctionne très bien lorsqu'il est seul sur feuille de classeur.
Donc, je l'ai intégré sur une feuille d'un autre classeur, mais lorsque j'ajoute ou que je supprime un contact dans Outlook, la liste de validation ne se met pas à jour, alors qu'elle se met à jour lorsque le code est seul sur une feuille dans un autre classeur. Pour moi, le code est tout à fait identique, alors je ne vois pas où est le problème.
Quelqu'un peut-il m'aider à résoudre cette énigme ?
D'avance je vous remercie pour votre aide.
Voici le code qui se trouve seul sur une feuille :
Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim olApp As Outlook.Application
Dim Cible As Outlook.ContactItem
Dim dossierContacts As Outlook.MAPIFolder
Dim Resultat 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
End Sub
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
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("A3") = Cible.CompanyName
Range("A2") = Cible.FullName
Range("A4") = Cible.BusinessAddressStreet
Range("A5") = Cible.BusinessAddressPostalCode
Range("B5") = Cible.BusinessAddressCity
End If
Fin:
Application.EnableEvents = True
Set Cible = Nothing
Set dossierContacts = Nothing
'olApp.Quit
Set olApp = Nothing
End Subet voici le même code compilé avec un autre code et c'est là que ça coince :
Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim olApp As Outlook.Application
Dim Cible As Outlook.ContactItem
Dim dossierContacts As Outlook.MAPIFolder
Dim Resultat 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
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Target, Range("G30")) Is Nothing Then
If Range("G30") = "Exaprint" Then
Rows("50:160").EntireRow.Hidden = True
Rows("33:49").EntireRow.Hidden = False
Else
Rows("50:160").EntireRow.Hidden = False
Rows("33:49").EntireRow.Hidden = True
End If
End If
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
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
End If
Fin:
Application.EnableEvents = True
Set Cible = Nothing
Set dossierContacts = Nothing
'olApp.Quit
Set olApp = Nothing
End Sub
