Hello
J’ai dans mon fichier de réservation plusieurs macros qui fonctionnent très bien. Actuellement, lorsque je mets une nouvelle réservation, celle-ci ouvre la macro Ajout de contact si la personne ne figure pas sur mon listing, et affiche un input box en cas de doublon de nom dans mon fichier contact, mais si aucun prénom ne correspond et que je sélectionne 0 je voudrais qu’à ce moment la macro Ajout contact se lance pour l’ajout du nouveau contact, et qu’une fois le nouveau contact enregistré la sauvegarde se poursuive.
je voudrais continuer avec les macros actuel
j’ai tenter comme dans la première un call ajout_contact dans le Do apres le case else de la macro ChercherPrenom qui actuellement sort de la macro si la reponse est vide
Merci d’avance pour vos lumières.
Option Compare Text
Sub Sauvegarde()
Dim numero As String
Dim cellule As Range
Dim ligne As Integer '*** Ligne declarer en tant que variable entier
ligne = 2 '*** depart de la variable ligne
Selection.Name = "sauve"
numero = Application.InputBox("Cliquez sur le numero de la table", "Saisie numéro")
Application.ScreenUpdating = False
'***Rennomer la feuille en cas de changement
Sheets("Réservation").Select
Sheets("Réservation").Unprotect
'***Atteindre la premiere cellule vide
While Sheets("Réservation").Cells(ligne, 2) <> ""
ligne = ligne + 1
Wend
'*** Selection de la cellule date
Sheets("Réservation").Cells(ligne, 2).Select
'***.........................***
Selection = Now()
Selection.Offset(0, 1) = Range("sauve").Item(1, 1)
Selection.Offset(0, 3) = Range("sauve").Item(1, 2)
Selection.Offset(0, 5) = CInt(numero)
'***Rennomer la feuille en cas de changement***
'Sheets("Table_Résa").Select
Application.ScreenUpdating = True
'MsgBox "Nouveau participant enregistré", vbOKOnly, "Information participant"
Call ChercherPrenom
Call tri_resa
Sheets("Réservation").Protect
Exit Sub
End Sub
Sub ChercherPrenom()
Dim ws As Worksheet
Dim nomRecherche As String
Dim plageNoms As Range, plagePrenoms As Range
Dim prenomsTrouves As Collection
Dim i As Long, reponse As String
Dim listeChoix As String
Dim ligneNom As Long
' Définir la feuille contact
Set ws = ThisWorkbook.Sheets("Contacts")
' Récupérer la ligne active dans Tab_Resa[NOM]
ligneNom = ActiveCell.Row
nomRecherche = Range("Tab_Resa[NOM]").Cells(ligneNom - Range("Tab_Resa[NOM]").Row + 1)
' Définir les plages de recherche
Set plageNoms = ws.Range("Tab_Contacts[NOM]")
Set plagePrenoms = ws.Range("Tab_Contacts[PRÉNOM]")
' Créer une collection pour stocker les prénoms trouvés
Set prenomsTrouves = New Collection
' Rechercher tous les prénoms correspondants au nom
For i = 1 To plageNoms.Rows.Count
If plageNoms.Cells(i, 1).Value = nomRecherche Then
On Error Resume Next
prenomsTrouves.Add plagePrenoms.Cells(i, 1).Value
On Error GoTo 0
End If
Next i
' Traiter selon le nombre de prénoms trouvés
Select Case prenomsTrouves.Count
Case 0
aPrenom = "" 'reset du prénom avant de lancer "AjoutContact"
AjoutContact 'ajouter un nouveau nom
Range("Tab_Resa[PRÉNOM]").Cells(ligneNom - Range("Tab_Resa[PRÉNOM]").Row + 1) = aPrenom 'le prénom de "AjoutContact"
'MsgBox "Aucun prénom trouvé pour ce nom."
Case 1
' Un seul prénom trouvé - l'utiliser directement sur la même ligne
Range("Tab_Resa[PRÉNOM]").Cells(ligneNom - Range("Tab_Resa[PRÉNOM]").Row + 1) = prenomsTrouves(1)
Case Else
' Plusieurs prénoms trouvés - créer la liste pour l'InputBox
listeChoix = "Plusieurs prénoms trouvés pour " & nomRecherche & vbNewLine & vbNewLine
For i = 1 To prenomsTrouves.Count
listeChoix = listeChoix & i & ". " & prenomsTrouves(i) & vbNewLine
Next i
Do
' Afficher l'InputBox avec la liste
reponse = InputBox(listeChoix & vbNewLine & _
"Entrez le numéro du prénom choisi :", _
"Choisir un prénom")
' Si l'utilisateur annule
If reponse = "" Then
Exit Sub
End If
' Vérifier si la réponse est valide
If IsNumeric(reponse) Then
If CInt(reponse) >= 1 And CInt(reponse) <= prenomsTrouves.Count Then
' Réponse valide, écrire le prénom et sortir de la boucle
Range("Tab_Resa[PRÉNOM]").Cells(ligneNom - Range("Tab_Resa[PRÉNOM]").Row + 1) = prenomsTrouves(CInt(reponse))
Exit Do
Else
MsgBox "Numéro invalide. Veuillez choisir un numéro entre 1 et " & prenomsTrouves.Count
End If
Else
MsgBox "Veuillez entrer un numéro valide."
End If
Loop
End Select
Commentaire.Show
End Sub
