Comment utiliser le bouton annulé d'un Inputbox

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

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...

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!