Problème de recherche selon des critères
bonjour je travaille sur un code qui me permet de retrouver des personnes dans une liste, selon certains critères. Les critères dans mon formulaire sont les suivants :
Code:
1
2
3
4
5
| RaisonSociale format RaisonSociale = UCase(RaisonSociale )
Titre format Titre = UCase(Titre )
Nom format Nom = UCase(Nom )
Prénom format Prenom = UCase(Prenom )
DateDeNaissance format DateDeNaissance.MaxLength = 8 |
Quand je lance mon application sans le critère DateDeNaissance mon application fonctionne parfaitement dès que je rajoute le critère DateDeNaissance elle n'effectue plus la recherche et je ne comprends pas pourquoi. Voici mon code en espérant que vous puissiez m'aider. Je vous en remercie d'avance pour votre aide car je dois présenter cette application cette semaine. Bonne journée.
Tallia :cry:
Code:
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
| Private Sub liste_noire_Click()
Dim DerLig As Long, lig As Long
Dim VRaisonsociale As String, VTitre As String, VNom As String, VPrenom As String, VDateDeNaissance As String
' Récupérer le numéro de ligne sur laquelle on se trouve
lig = ActiveCell.Row
' Mémoriser la raison sociale, le titre, le nom,le prénom, la date de naissance de la ligne sélectionnée
VRaisonsociale = ActiveSheet.Range("A" & lig).Value
VTitre = ActiveSheet.Range("B" & lig).Value
VNom = ActiveSheet.Range("C" & lig).Value
VPrenom = ActiveSheet.Range("D" & lig).Value
VDateDeNaissance = ActiveSheet.Range("E" & lig).Value
' Vérifier l'existence d'une raison sociale nom et prénom sur la ligne
If VRaisonsociale = "" And VTitre = "" And VNom = "" And VPrenom = "" And VDateDeNaissance = "" Then
MsgBox "Merci de selectionner une ligne avec un titre un nom et prénom et une date de naissance"
Exit Sub
End If
' Effectuer une recherche de doublon
If NbVSearch(VRaisonsociale, VTitre, VNom, VPrenom, VDateDeNaissance) > 0 Then
If MsgBox("Attention cette personne fait déjà partie de la liste !" & vbCrLf & vbCrLf _
& "Voulez-vous continuer ?", vbQuestion + vbYesNo, "ATTENTION ...") = vbNo Then
'AJOUT.Hide
End If
ActiveSheet.Range("A" & lig & ":P" & lig).Interior.ColorIndex = 3
End If
end sub
Function NbVSearch(RaisonSociale As String, TITRE As String, NOM As String, PRENOM As String, DateDeNaissance As String)
Dim myformule As String
myformule = "SUMPRODUCT((liste_noire!$A$2:$A$65535=""" & RaisonSociale & """)*(liste_noire!$B$2:$B$65535=""" & TITRE & """)*(liste_noire!$C$2:$C$65535=""" & NOM & """)*(liste_noire!$D$2:$D$65535=""" & PRENOM & """)*(liste_noire!$E$2:$E$65535=""" & DateDeNaissance & """))"
NbVSearch = Application.Evaluate(myformule)
' si la raison sociale est vide
If RaisonSociale = "" Then
myformule = "sumproduct((liste_noire!$B$2:$B$65535=""" & TITRE & """)*(liste_noire!$C$2:$C$65535=""" & NOM & """)*(liste_noire!$D$2:$D$65535=""" & PRENOM & """)*(liste_noire!$E$2:$E$65535=""" & DateDeNaissance & """))"
End If
End Function |
