Comment utiliser le bouton annulé d'un Inputbox

Résolu/Fermé
Signaler
Messages postés
270
Date d'inscription
jeudi 19 février 2015
Statut
Membre
Dernière intervention
12 avril 2021
-
Messages postés
270
Date d'inscription
jeudi 19 février 2015
Statut
Membre
Dernière intervention
12 avril 2021
-
Bonjour à tous!

J'ai une macro avec un InputBox, elle marche bien lorsque je saisie une valeur à l'intérieure. Mais lorsque je veux annulé avec le bouton, il me renvoie la valeur faux dans la cellule sélectionnée.

J'ai essayé de lui dire si il y a une valeur pour NewVal alors exécute la macro sinon sort de la macro, mai sans succès!

Je voudrais que lorsque j'appui sur le bouton annulé de l'InputBox, qu'il quitte la macro.

Voici mon code:

Private dlig As Long
Private PL As Range
Option Explicit
  
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Dim nValue As String
Dim NewVal As String
Dim f As Worksheet
Dim valueRange As Range


Application.ScreenUpdating = False


For Each f In ActiveWorkbook.Worksheets
    f.Unprotect
Next

nValue = ActiveCell.Value

If Not Intersect(Target, Range("c5:c" & [a1048576].End(xlUp).Row + 1)) Is Nothing Then
        
    If MsgBox("Voulez-vous mofifier le numéro de ce sondage?", _
        vbYesNo + vbQuestion, "MODIFER") = vbYes Then
                
        NewVal = UCase$(Application.InputBox("Nouveau numéro de sondage?", "MODIFICATION DE NUMÉRO", Type:=2))
        If NewVal = "" Then
        ActiveCell = NewVal
        Else
        ActiveCell.Offset(-1, 0).Select
        Exit Sub
        End If
        
            If InStr(1, nValue, "C") = 1 Or InStr(1, nValue, "M") = 1 Then
                Set valueRange = Sheets("CPTU").Columns(1)
                
            ElseIf InStr(1, nValue, "F") = 1 Then
                Set valueRange = Sheets("FORAGE").Columns(1)
                
            ElseIf InStr(1, nValue, "Z") = 1 Or InStr(1, nValue, "FZ") = 1 Then
                Set valueRange = Sheets("Piézomètres").Columns(2)
               
            ElseIf InStr(1, nValue, "I") = 1 Then
                Set valueRange = Sheets("Inclinomètres").Columns(2)
                
            Else
                Set valueRange = Nothing
                MsgBox "La valeur n'a pas été trouvé dans les autres feuilles! Mettre à jours les feuillets sur la page d'accueil!", vbCritical
            End If
            
                If Not valueRange Is Nothing Then
                    valueRange.Replace nValue, NewVal, LookAt:=xlWhole, SearchOrder:=xlByColumns
                End If

        
                                   
        If NewVal <> nValue Then
        MsgBox "N'oubliez pas de changer le numéro dans la colonne ABRÉVIATION!", vbExclamation, "IMPORTANT"
        ActiveCell.Offset(-1, 0).Select
        End If
        
    Else
    
    ActiveCell.Offset(-1, 0).Select
    
    End If
    
End If

For Each f In ActiveWorkbook.Worksheets
            f.Protect
        Next
        

Application.ScreenUpdating = True
Application.EnableEvents = True

 
End Sub




A voir également:

1 réponse

Messages postés
12257
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
3 septembre 2021
2 677
Bonjour,

Regarde cette fiche pratique CCM, en particulier ce chapitre à propos du bouton annuler.
0
Messages postés
270
Date d'inscription
jeudi 19 février 2015
Statut
Membre
Dernière intervention
12 avril 2021
1
Merci beaucoup pour le lien pijaku!

Mais ça ne marche pas plus! Je n'y comprend rien!

J'ai essayé les 2 codes et dans les 2 cas lorsque je sélectionne le bouton annulé dans l'InputBox, il saute à ligne après le loop. C'est probablement le gars derrière le clavier le problème!

Voici ce que j'ai fait:
Private dlig As Long
Private PL As Range
Option Explicit
  
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Dim nValue As String
Dim NewVal As String
Dim f As Worksheet
Dim valueRange As Range
Dim Cpt As Integer


Application.ScreenUpdating = False


For Each f In ActiveWorkbook.Worksheets
    f.Unprotect
Next

nValue = ActiveCell.Value

If Not Intersect(Target, Range("c5:c" & [a1048576].End(xlUp).Row + 1)) Is Nothing Then
        
    If MsgBox("Voulez-vous mofifier le numéro de ce sondage?", _
        vbYesNo + vbQuestion, "MODIFER") = vbYes Then
        
        Cpt = 1
        NewVal = UCase$(Application.InputBox("Nouveau numéro de sondage?", "MODIFICATION DE NUMÉRO", Type:=2))
        
        Do While Len(NewVal) = 0
            Cpt = Cpt + 1
            If Cpt = 4 Then GoTo TropBetePourContinuer
            ActiveCell.Offset(-1, 0).Select
            Exit Sub
        Loop
        ActiveCell = NewVal
        
TropBetePourContinuer:
        MsgBox "Veuillez arrêter l'informatique"
        
            If InStr(1, nValue, "C") = 1 Or InStr(1, nValue, "M") = 1 Then
                Set valueRange = Sheets("CPTU").Columns(1)
                
            ElseIf InStr(1, nValue, "F") = 1 Then
                Set valueRange = Sheets("FORAGE").Columns(1)
                
            ElseIf InStr(1, nValue, "Z") = 1 Or InStr(1, nValue, "FZ") = 1 Then
                Set valueRange = Sheets("Piézomètres").Columns(2)
               
            ElseIf InStr(1, nValue, "I") = 1 Then
                Set valueRange = Sheets("Inclinomètres").Columns(2)
                
            Else
                Set valueRange = Nothing
                MsgBox "La valeur n'a pas été trouvé dans les autres feuilles! Mettre à jours les feuillets sur la page d'accueil!", vbCritical
            End If
            
                If Not valueRange Is Nothing Then
                    valueRange.Replace nValue, NewVal, LookAt:=xlWhole, SearchOrder:=xlByColumns
                End If

        
                                   
        If NewVal <> nValue Then
        MsgBox "N'oubliez pas de changer le numéro dans la colonne ABRÉVIATION!", vbExclamation, "IMPORTANT"
        ActiveCell.Offset(-1, 0).Select
        End If
        
    Else
    
    ActiveCell.Offset(-1, 0).Select
    
    End If
    
End If

For Each f In ActiveWorkbook.Worksheets
            f.Protect
        Next
        

Application.ScreenUpdating = True
Application.EnableEvents = True

 
End Sub


Pouvez-vous m'aider, merci!
0
Messages postés
12257
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
3 septembre 2021
2 677 >
Messages postés
270
Date d'inscription
jeudi 19 février 2015
Statut
Membre
Dernière intervention
12 avril 2021

C'est probablement le gars derrière le clavier le problème!
Pas forcément. Quand on est dedans on ne voit pas tout...
Notamment le traitement d'erreur.
Le Goto doit renvoyer à une étiquette qui "clos" le code. Comme ceci :
Private dlig As Long
Private PL As Range
Option Explicit
  
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Dim nValue As String
Dim NewVal As String
Dim f As Worksheet
Dim valueRange As Range
Dim Cpt As Integer


Application.ScreenUpdating = False


For Each f In ActiveWorkbook.Worksheets
    f.Unprotect
Next

nValue = ActiveCell.Value

If Not Intersect(Target, Range("c5:c" & [a1048576].End(xlUp).Row + 1)) Is Nothing Then
        
    If MsgBox("Voulez-vous mofifier le numéro de ce sondage?", _
        vbYesNo + vbQuestion, "MODIFER") = vbYes Then
        
        Cpt = 1
        NewVal = UCase$(Application.InputBox("Nouveau numéro de sondage?", "MODIFICATION DE NUMÉRO", Type:=2))
        
        Do While Len(NewVal) = 0
            Cpt = Cpt + 1
'*-*-*-*-*-*-*-*-*-*-*ICI LA SOURCE D'ERREUR POSSIBLE (GoTo renverra au traitement d'erreur en fin de code)
            If Cpt = 4 Then GoTo TropBetePourContinuer
            ActiveCell.Offset(-1, 0).Select
            Exit Sub
        Loop
        ActiveCell = NewVal
               
            If InStr(1, nValue, "C") = 1 Or InStr(1, nValue, "M") = 1 Then
                Set valueRange = Sheets("CPTU").Columns(1)
                
            ElseIf InStr(1, nValue, "F") = 1 Then
                Set valueRange = Sheets("FORAGE").Columns(1)
                
            ElseIf InStr(1, nValue, "Z") = 1 Or InStr(1, nValue, "FZ") = 1 Then
                Set valueRange = Sheets("Piézomètres").Columns(2)
               
            ElseIf InStr(1, nValue, "I") = 1 Then
                Set valueRange = Sheets("Inclinomètres").Columns(2)
                
            Else
                Set valueRange = Nothing
                MsgBox "La valeur n'a pas été trouvé dans les autres feuilles! Mettre à jours les feuillets sur la page d'accueil!", vbCritical
            End If
            
                If Not valueRange Is Nothing Then
                    valueRange.Replace nValue, NewVal, LookAt:=xlWhole, SearchOrder:=xlByColumns
                End If
                                 
        If NewVal <> nValue Then
        MsgBox "N'oubliez pas de changer le numéro dans la colonne ABRÉVIATION!", vbExclamation, "IMPORTANT"
        ActiveCell.Offset(-1, 0).Select
        End If
        
    Else
    
    ActiveCell.Offset(-1, 0).Select
    
    End If
    
End If

For Each f In ActiveWorkbook.Worksheets
            f.Protect
        Next
        

Application.ScreenUpdating = True
Application.EnableEvents = True
'ON QUITTE LA PROCEDURE pour ne pas entrer dans le traitement d'erreur
Exit Sub
'*-*-*-*-*-*-*-*-*-*-ICI LE TRAITEMENT D'ERREUR
TropBetePourContinuer:
        MsgBox "Veuillez arrêter l'informatique"
End Sub
0
Messages postés
270
Date d'inscription
jeudi 19 février 2015
Statut
Membre
Dernière intervention
12 avril 2021
1
Bonjour pijaku!

Ça ne marche pas comme je veux! Lorsque j'appui sur le bouton annulé dans l'InputBox il continue avec NewVal qui est égale à zéro ou vide et il me renvoie la valeur faux dans la cellule sélectionnée.

Alors que je veux que lorsque j'appui sur cette touche qu'il sorte de la macro.

Merci!
0
Messages postés
12257
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
3 septembre 2021
2 677 >
Messages postés
270
Date d'inscription
jeudi 19 février 2015
Statut
Membre
Dernière intervention
12 avril 2021

Bonjour,

Tu n'as pas utilisé mot pour moi le code donné par mon exemple.
Mea Culpa, je n'avais pas vu que tu utilisais une Application.InputBox de type 2 (chaîne de caractères). Ce type d'InputBox particulier renvoie "Faux" lorsqu'est cliqué le bouton Annuler.
Le test à faire alors pour sortir de la Sub est donc le suivant :
If NewVal = False Then Exit Sub

Ce qui te donne, à partir de ton code initial :
Private dlig As Long
Private PL As Range
Option Explicit
  
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim nValue As String
Dim NewVal As String
Dim f As Worksheet
Dim valueRange As Range

Application.ScreenUpdating = False
For Each f In ActiveWorkbook.Worksheets
    f.Unprotect
Next
nValue = ActiveCell.Value
If Not Intersect(Target, Range("c5:c" & [a1048576].End(xlUp).Row + 1)) Is Nothing Then  
    If MsgBox("Voulez-vous mofifier le numéro de ce sondage?", _
        vbYesNo + vbQuestion, "MODIFER") = vbYes Then      
        NewVal = UCase$(Application.InputBox("Nouveau numéro de sondage?", "MODIFICATION DE NUMÉRO", Type:=2))
        If NewVal = False Then
            ActiveCell.Offset(-1, 0).Select
            Exit Sub
        Else
            ActiveCell = NewVal
        End If
            If InStr(1, nValue, "C") = 1 Or InStr(1, nValue, "M") = 1 Then
                Set valueRange = Sheets("CPTU").Columns(1)
            ElseIf InStr(1, nValue, "F") = 1 Then
                Set valueRange = Sheets("FORAGE").Columns(1)
            ElseIf InStr(1, nValue, "Z") = 1 Or InStr(1, nValue, "FZ") = 1 Then
                Set valueRange = Sheets("Piézomètres").Columns(2)
            ElseIf InStr(1, nValue, "I") = 1 Then
                Set valueRange = Sheets("Inclinomètres").Columns(2)
            Else
                Set valueRange = Nothing
                MsgBox "La valeur n'a pas été trouvé dans les autres feuilles! Mettre à jours les feuillets sur la page d'accueil!", vbCritical
            End If
                If Not valueRange Is Nothing Then
                    valueRange.Replace nValue, NewVal, LookAt:=xlWhole, SearchOrder:=xlByColumns
                End If
        If NewVal <> nValue Then
            MsgBox "N'oubliez pas de changer le numéro dans la colonne ABRÉVIATION!", vbExclamation, "IMPORTANT"
            ActiveCell.Offset(-1, 0).Select
        End If
    Else
        ActiveCell.Offset(-1, 0).Select
    End If
End If
For Each f In ActiveWorkbook.Worksheets
    f.Protect
Next
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub


Notes :
Si tu veux "donner" plusieurs essais à l'utilisateur, tu peux insérer la boucle Do While avec le compteur (Cpt). Dans le cas contraire, c'est ici inutile.

Application.EnableEvents = True
en fin de code est inutile puisque tu ne le places pas à False en début de code...
0
Messages postés
270
Date d'inscription
jeudi 19 février 2015
Statut
Membre
Dernière intervention
12 avril 2021
1 >
Messages postés
12257
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
3 septembre 2021

Merci beaucoup pijaku!

C'est exactement ça! Ça fonctionne super!

Pour le
Application.EnableEvents = True
, je l'ai placé dans mon code parce que dans ma feuille, j'ai une autre macro qui s'effectue lors d'un changement dans la feuille. Elle se lance, donc à l'intérieure de cette macro lorsque je change la valeur d'une cellule et à la fin de l'exécution des 2 macros, aucune macro ne fonctionnent et en placent cette commande, tout est ok.

Peut-être pas la meilleur méthode, mais ça fonctionne!

Voici les macro en arrière de cette feuille:
Private dlig As Long
Private PL As Range
Option Explicit
  
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Dim nValue As String
Dim NewVal As String
Dim f As Worksheet
Dim valueRange As Range
Dim Cpt As Integer


Application.ScreenUpdating = False

For Each f In ActiveWorkbook.Worksheets
    f.Unprotect
Next

nValue = ActiveCell.Value

If Not Intersect(Target, Range("c5:c" & [a1048576].End(xlUp).Row + 1)) Is Nothing Then
        
    If MsgBox("Voulez-vous mofifier le numéro de ce sondage?", _
        vbYesNo + vbQuestion, "MODIFER") = vbYes Then
        
        Cpt = 1
        NewVal = UCase$(Application.InputBox("Nouveau numéro de sondage?", "MODIFICATION DE NUMÉRO", Type:=2))
        
        If NewVal = False Then
            ActiveCell.Offset(-1, 0).Select
            Exit Sub
        Else
            ActiveCell = NewVal
        End If
        
        
            If InStr(1, nValue, "C") = 1 Or InStr(1, nValue, "M") = 1 Then
                Set valueRange = Sheets("CPTU").Columns(1)
                
            ElseIf InStr(1, nValue, "F") = 1 Then
                Set valueRange = Sheets("FORAGE").Columns(1)
                
            ElseIf InStr(1, nValue, "Z") = 1 Or InStr(1, nValue, "FZ") = 1 Then
                Set valueRange = Sheets("Piézomètres").Columns(2)
               
            ElseIf InStr(1, nValue, "I") = 1 Then
                Set valueRange = Sheets("Inclinomètres").Columns(2)
                
            Else
                Set valueRange = Nothing
                MsgBox "La valeur n'a pas été trouvé dans les autres feuilles! Mettre à jours les feuillets sur la page d'accueil!", vbCritical
            End If
            
                If Not valueRange Is Nothing Then
                    valueRange.Replace nValue, NewVal, LookAt:=xlWhole, SearchOrder:=xlByColumns
                End If

        
                                   
        If NewVal <> nValue Then
        MsgBox "N'oubliez pas de changer le numéro dans la colonne ABRÉVIATION!", vbExclamation, "IMPORTANT"
        ActiveCell.Offset(-1, 0).Select
        End If
        
    Else
    
    ActiveCell.Offset(-1, 0).Select
    
    End If
    
End If

For Each f In ActiveWorkbook.Worksheets
            f.Protect
        Next
        

Application.ScreenUpdating = True
Application.EnableEvents = True

 
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

ActiveSheet.Unprotect

If Target.Column >= 3 And Target.Column <= 5 Then
        'desactive les evenements excel: eviter appel recurcif a la suite du passage en majuscule
        Application.EnableEvents = False
        Target = UCase(Target)
    End If
    'active les evenements excel
    Application.EnableEvents = True


If Target.Cells.Count > 1 Then Exit Sub
If Target.Row < 5 Or Target.Column <> 5 Then Exit Sub
If Target.Value = "" Then Cells(Target.Row, 1).ClearContents
If Range("A5") <> "" Then
    dlig = Range("E5").End(xlDown).Row
    Set PL = Range("A5:A" & dlig)
    PL.Value = Range("a5").Value
   
End If


Dim T As Range, i&
Set T = [TableauCoord]
Application.EnableEvents = False
On Error Resume Next 'sécurité
If T.Rows.Count < 4 Then
  Application.Undo 'annulation
Else
  '---suppression des lignes vides---
  For i = T.Rows.Count - 1 To 4 Step -1
    If T(i, 1) = "" Then T(i, 1).EntireRow.Delete
  Next
  '---ajout de ligne---
  If T(T.Rows.Count, 1) <> "" Then
    Application.ScreenUpdating = False
    T(T.Rows.Count, 1).EntireRow.Insert
    T.Rows(T.Rows.Count - 1).FormulaR1C1 = T.Rows(T.Rows.Count).FormulaR1C1
    T.Rows(T.Rows.Count) = ""
    Application.ScreenUpdating = True
  End If
End If

Dim Valeur As String
Dim Plage, Cellule As Range

' Ici spécifier la plage à couvrir !
Set Plage = Range("N5:N" & dlig)

For Each Cellule In Plage
Valeur = Mid(Cellule.Value, 2)
Valeur = UCase(Mid(Cellule.Value, 1, 1)) & Valeur
Cellule.Value = Valeur
Next Cellule

Application.EnableEvents = True

ActiveSheet.Protect

End Sub

Private Sub Worksheet_Activate()
   
Dim resultat As String
Const Dossier As String = "6.02.06.MT.02."

ActiveSheet.Unprotect
If Range("a5") = 0 Then
    resultat = UCase(InputBox("Entrez le numéro du Bassin Versant!", "Bassin Versant"))
    If resultat <> "" Then
        dlig = Range("E5").End(xlDown).Row
        Set PL = Range("A5:A" & dlig)
        PL.Value = Dossier & resultat
    End If
    
End If

ActiveSheet.Protect
Range("b5").Select


End Sub



Encore merci!
0