Provence Vintage
XLDnaute Occasionnel
Bonjour, le Forum,
Qui peux m'aider avec la fonction Select case, pour réecrire mon code correctement:
en fonction de Label44.Caption,
si Vrai cas 1 = Réponse1
Si faux Cas 2 = réponse2
Merci
Private Sub ReponseDoublon()
Dim réponse1
Dim réponse2
Dim cel As Range
Worksheets("bdd acheteur").Activate
Set cel = Range("A1")
Set cel = Columns(1).Find(What:=Label44.Caption, After:=cel, _
LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
Select Case ActiveCell
Case1 = False
réponse1 = MsgBox(" Cet Acquéreur n'éxiste pas, Voulez Vous créer sa Fiche ? ", vbYesNo + vbQuestion, "Validation")
If réponse1 = vbNo Then
Nom = ""
Nom.SetFocus
Exit Sub
End If
If réponse1 = vbYes Then
TelFixe.SetFocus
End If
Case2 = True
réponse2 = MsgBox(" Cet Acquéreur éxiste déjà, Voulez Vous Modifier sa Fiche ? ", vbYesNo + vbQuestion, "Validation")
If réponse2 = vbNo Then
Nom = ""
Nom.SetFocus
Exit Sub
End If
If réponse2 = vbYes Then
Nom.SetFocus
End If
Worksheets("bdd acheteur").Activate
Set cel = Range("A1")
Set cel = Columns(1).Find(What:=Nom, After:=cel, _
LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
If Not cel Is Nothing Then
Application.ScreenUpdating = False
L = cel.Row
TelFixe = Cells(L, "E")
Mail = Cells(L, "F")
DateCréationacheteur = Cells(L, "G")
BudgetFAI = Cells(L, "H")
VilleExclueChoix1 = Cells(L, "J")
VilleChoix2 = Cells(L, "K")
VilleChoix3 = Cells(L, "L")
VilleChoix4 = Cells(L, "M")
VilleChoix5 = Cells(L, "N")
TypedeSecteur = Cells(L, "O")
TypeT = Cells(L, "Q")
SurfaceHabitableMini = Cells(L, "S")
SurfaceTerrainMini = Cells(L, "T")
Commentaires = Cells(L, "AB")
TravailMME = Cells(L, "AD")
TravailMR = Cells(L, "AE")
NombreMoisRecherche = Cells(L, "AJ")
If Cells(L, "I") = "Oui" Then
TousSecteurs = True
Else: TousSecteurs = False
..............
Qui peux m'aider avec la fonction Select case, pour réecrire mon code correctement:
en fonction de Label44.Caption,
si Vrai cas 1 = Réponse1
Si faux Cas 2 = réponse2
Merci
Private Sub ReponseDoublon()
Dim réponse1
Dim réponse2
Dim cel As Range
Worksheets("bdd acheteur").Activate
Set cel = Range("A1")
Set cel = Columns(1).Find(What:=Label44.Caption, After:=cel, _
LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
Select Case ActiveCell
Case1 = False
réponse1 = MsgBox(" Cet Acquéreur n'éxiste pas, Voulez Vous créer sa Fiche ? ", vbYesNo + vbQuestion, "Validation")
If réponse1 = vbNo Then
Nom = ""
Nom.SetFocus
Exit Sub
End If
If réponse1 = vbYes Then
TelFixe.SetFocus
End If
Case2 = True
réponse2 = MsgBox(" Cet Acquéreur éxiste déjà, Voulez Vous Modifier sa Fiche ? ", vbYesNo + vbQuestion, "Validation")
If réponse2 = vbNo Then
Nom = ""
Nom.SetFocus
Exit Sub
End If
If réponse2 = vbYes Then
Nom.SetFocus
End If
Worksheets("bdd acheteur").Activate
Set cel = Range("A1")
Set cel = Columns(1).Find(What:=Nom, After:=cel, _
LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
If Not cel Is Nothing Then
Application.ScreenUpdating = False
L = cel.Row
TelFixe = Cells(L, "E")
Mail = Cells(L, "F")
DateCréationacheteur = Cells(L, "G")
BudgetFAI = Cells(L, "H")
VilleExclueChoix1 = Cells(L, "J")
VilleChoix2 = Cells(L, "K")
VilleChoix3 = Cells(L, "L")
VilleChoix4 = Cells(L, "M")
VilleChoix5 = Cells(L, "N")
TypedeSecteur = Cells(L, "O")
TypeT = Cells(L, "Q")
SurfaceHabitableMini = Cells(L, "S")
SurfaceTerrainMini = Cells(L, "T")
Commentaires = Cells(L, "AB")
TravailMME = Cells(L, "AD")
TravailMR = Cells(L, "AE")
NombreMoisRecherche = Cells(L, "AJ")
If Cells(L, "I") = "Oui" Then
TousSecteurs = True
Else: TousSecteurs = False
..............