[déplacé Boite Idées = VBA] Macro excelRésolu

Question

Bonjour, J’ai un problème avec la macro suivante : Je souhaiterais que cette dernière, lorsqu’elle ne trouve pas le nom de mon clients, arrête la recherche. Quelqu’un pourrait-il m’aider s’il vous plait ? Merci Sub Nom_Recherché_Clients() ' Déclaration de variable Dim recherche_Contact As String Dim Cellule As Range, ListeCellules As Range Dim ListeNoms As String, Adresse1 As String ' Selectionne la feuille Contacts Sheets("CLIENTS").Select SAISIE_NOM: recherche_Contact = InputBox("Entrez le nom du Contact: ", "recherche Contact") If recherche_Contact = Empty Then Exit Sub Set Cellule = Columns("B").Find _ (What:=recherche_Contact, LookIn:=xlValues, LookAt:=xlPart) If Cellule Is Nothing Then MsgBox "Aucune réponse pour " & recherche_Contact GoTo SAISIE_NOM End If Adresse1 = Cellule.Address Set ListeCellules = Cellule.Offset(0, 1) Do ListeNoms = ListeNoms & Chr(10) & _ Cellule.Value & ", " & Cellule.Offset(0, 1).Value Set Cellule = Columns("B").FindNext(Cellule) Set ListeCellules = Union(ListeCellules, Cellule.Offset(0, 1)) Loop Until Cellule Is Nothing Or Cellule.Address = Adresse1 SAISIE_PRENOM: If ListeCellules.Count > 1 Then recherche_Contact = InputBox("Précisez le prénom : " & Chr(10) & ListeNoms) If recherche_Contact = Empty Then Exit Sub Set Cellule = ListeCellules.Find _ (What:=recherche_Contact, LookIn:=xlValues, LookAt:=xlPart) If Cellule Is Nothing Then MsgBox "Aucune réponse pour " & recherche_Contact GoTo SAISIE_PRENOM End If End If Cellule.EntireRow.Select Selection.Cut Rows("2:2").Select ActiveSheet.Paste Application.Run "PERSO.XLS!Supprime_lignes_vides" End Sub Nanie

cs_Orohena · Accepted Answer

Bonjour nanieb

Je te propose :
        MsgBox "Aucune réponse pour " & recherche_Contact<?xml:namespace prefix o ns "urn:schemas-microsoft-com:office:office" /??>




        Exit Sub
' au lieu de : 

GoTo SAISIE_NOM


Mais peut-être que j'ai mal compris ta question ...

Cordialement

nanieb · Answer

Bonjour et merci, 
La procédure de recherche s'arrête bien lorsqu'il n'y a pas de nom trouvé. 
Mais il reste un problème, la macro s'arrête alors que le programme n'est pas terminé. 

   
Sub Nom_Recherché_Clients()
    ' Déclaration de variable
    Dim recherche_Contact As String
    Dim Cellule As Range, ListeCellules As Range
    Dim ListeNoms As String, Adresse1 As String
    ' Selectionne la feuille Contacts
    Sheets("CLIENTS").Select
SAISIE_NOM:
    recherche_Contact = InputBox("Entrez le nom du Contact: ", "recherche Contact")
    If recherche_Contact = Empty Then Exit Sub
    Set Cellule = Columns("B").Find _
                  (What:=recherche_Contact, LookIn:=xlValues, LookAt:=xlPart)
    If Cellule Is Nothing Then
        MsgBox "Aucune réponse pour " & recherche_Contact
        'GoTo SAISIE_NOM
        Exit Sub
    End If
    Adresse1 = Cellule.Address
    Set ListeCellules = Cellule.Offset(0, 1)
    Do
        ListeNoms = ListeNoms & Chr(10) & _
                    Cellule.Value & ", " & Cellule.Offset(0, 1).Value
        Set Cellule = Columns("B").FindNext(Cellule)
        Set ListeCellules = Union(ListeCellules, Cellule.Offset(0, 1))
    Loop Until Cellule Is Nothing Or Cellule.Address = Adresse1
    
SAISIE_PRENOM:
    If ListeCellules.Count > 1 Then
        recherche_Contact = InputBox("Précisez le prénom : " & Chr(10) & ListeNoms)
        If recherche_Contact = Empty Then Exit Sub
        Set Cellule = ListeCellules.Find _
                    (What:=recherche_Contact, LookIn:=xlValues, LookAt:=xlPart)
        If Cellule Is Nothing Then
            MsgBox "Aucune réponse pour " & recherche_Contact
            GoTo SAISIE_PRENOM
        End If
    End If

   ' LA MACRO S'ARRETE ICI 
   ' Comment faire pour que cette macro se termine normalement 

    Cellule.EntireRow.Select
    Selection.Cut
    Rows("2:2").Select
    ActiveSheet.Paste
    Application.Run "PERSO.XLS!Supprime_lignes_vides"
    Application.Run "PERSO.XLS!AjouteUnClient"
End Sub

Nanie

jmf0 · Answer

Bonjour,

va voir le code que j'ai donné ici :
http://www.vbfrance.com/forum/sujet-PROGRAMME-VB6_1229215.aspx
Il devrait t'inspirer.
En lieu et place de Do While reponse <> "blablabla"
- initialise une variable booléenne à false, genre :

toto = false
puis 
Do While toto = false
.....reponse = inputbox(.......)
.....
..... si trouvé : ===>> toto = True
......
Loop
Fais celà pour chacune de tes inputboxes et débarrasse-toi de tous ces vilains Goto.

[déplacé Boite Idées => VBA] Macro excel

3 réponses

Votre réponse

Discussions similaires