Problème avec exit sub

jadami Messages postés 107 Statut Membre -  
yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   -
Bonjour,

Avec ce code je voudrais lorsque la liste déroulante cmbRegroupFamille est Null
arrêter la procédure par Exit Sub et afficher le message «RegroupFamille non défini».

Le Exit Sub n’a aucun effet, le code se poursuit et m’affiche «Renouvelé»

Private Sub cmbRecherche_AfterUpdate()
On Error Resume Next

'---Inialisation du nom du formulaire
frm = "frm Màj des adhérents"

'--- Rechercher l'enregistrement correspondant au contrôle.
Set rs = Forms(frm).Recordset
rs.FindFirst "RéfAdhérent = " & Str(Val(Nz(Me![cmbRecherche], 0)))
If Not rs.EOF Then Forms(frm).Bookmark = rs.Bookmark

'--- Utilisation du select Case pour appeler la sub ConditionAnomalieR
Select Case cmbStatut
Case "N"
!!!!!!!!
Case "R"
Call ConditionAnomalieR

If (Me.cmbCoders = 1 And Me.txtMillLicence = AnnéeSportive And (Me.txtDateDépart = "" Or IsNull(Me.txtDateDépart)) And Me.cmbRegroupFamille.Value >= 1 And (IsNull(Champ_Montant) Or Champ_Montant = "") And Me.Cocher97 = 0) Then
strMessage = "Chèque à saisir"
Me.lblMessage.Caption = strMessage
Me.lblMessage2.Caption = strMessage
Else
strMessage = "Renouvelé"
Me.lblMessage.Caption = strMessage
Me.lblMessage2.Caption = strMessage
End If
End select
En sub

Sub ConditionAnomalieR()
'---Teste si la zone RegroupFamille est renseigné
If IsNull(cmbRegroupFamille.Value) Or cmbRegroupFamille.Value = "" Then

'Boite de dialogue par Api
reponse = MessageBox(Me.hwnd, "Veuillez vérifier la fiche de : " & cmbCivilité & " " & txtNomAdhérent _
& vbCrLf & vbCrLf & " La zone RegroupFamille n'est pas renseignée." _
& vbCrLf & vbCrLf & "Veuillez vérifier la zone RegroupFamille. ", _
ap_AppTitle(), MB_DEFBUTTON2 + MB_ICONEXCLAMATION)
If reponse = vbOK Then
Me.lblMessage.Caption = " RegroupFamille non défini"
Me.lblMessage2.Caption = " RegroupFamille non défini"
Me.cmbRegroupFamille.SetFocus
Exit Sub
End If
End If
End sub

Pour quelle raison Exit Sub est inopérant ?

Merci pour votre aide.

Salutations

5 réponses

  1. jordane45 Messages postés 30426 Date d'inscription   Statut Modérateur Dernière intervention   4 830
     
    Bonjour

    Exit sub.. quitte la sub courrante..
    Dont il quitte la sub où il se trouve.. pas celle d'après
    1
  2. jordane45 Messages postés 30426 Date d'inscription   Statut Modérateur Dernière intervention   4 830
     
    Tu transformes ta sub ConditionAnomalieR en fonction qui retourne true ou false et tu testes ke retour dand un if dans ta première sub
    1
  3. yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   Ambassadeur 1 588
     
    bonjour, l'idée, en gros, est de faire ceci:
    '...
     if ConditionAnomalieR() then
          exit sub
     end if
    '...
    function ConditionAnomalieR() as boolean
    ' ...
             If reponse = vbOK Then
                   Me.lblMessage.Caption = " RegroupFamille non défini"
                   Me.lblMessage2.Caption = " RegroupFamille non défini"
                  Me.cmbRegroupFamille.SetFocus
                  ConditionAnomalieR=true
                  Exit Sub
            End If
       End If
    ConditionAnomalieR=false
    End sub 
     
    1
  4. jadami Messages postés 107 Statut Membre
     
    Bonjour,

    Merci pour la réponse.

    Mais comment faire pour ne pas atteindre la deuxième sub ?

    Salutations
    0
  5. Vous n’avez pas trouvé la réponse que vous recherchez ?

    Posez votre question
  6. jadami
     
    Bonjour,

    J’ai besoin d’aide car je n’arrive pas à résoudre mon problème, je connais mal les Fonctions.

    Sur cette sub Private Sub cmbRecherche_AfterUpdate(), j’ai rajouté :

    Case "R"
    Call ConditionAnomalieR(True) «le True rajouté»

    If Argum = False Then “ le iF rajouté”
    If (Me.cmbCoders = 1 !!!!!!!!!!!!! then
    strMessage = "Chèque à saisir"
    Else
    strMessage = "Renouvelé"
    End if
    End if

    La Sub ConditionAnomalieR() je l’ai transformé de cette façon :

    Private Function ConditionAnomalieR(ByVal Argum As Integer) As Boolean

    If IsNull(cmbRegroupFamille.Value) Or cmbRegroupFamille.Value = "" Then
    'Boite de dialogue par Api
    reponse = MessageBox(Me.hwnd !!!!!!!!!!!!!!!!!!!!!
    If reponse = vbOK Then
    Me.lblMessage2.Caption = " RegroupFamille non défini"
    Me.cmbRegroupFamille.SetFocus

    Argum = True “ Argum Rajouté”

    Exit function
    End If
    End If

    End function

    Merci d’avance pour ton aide

    Salutations
    0