XL 2016 Caractère "espace" dans inputbox

[MickaeL_D]

Bonjour à tous les experts,

Dans la macro ci-dessous (déjà créée avec les experts). Je souhaiterais empêcher les opérateurs de "shunter" la Inputbox juste en tapant sur "espace" en premier caractère.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Cellule_en_Cours As Range
    If Not Intersect(Target, Range("E23:G999")) Is Nothing Then
        For Each Cellule_en_Cours In Intersect(Target, Range("E23:G999"))
            If Not (Range("E" & Cellule_en_Cours.Row) = "" Or Range("F" & Cellule_en_Cours.Row) = "" Or Range("G" & Cellule_en_Cours.Row) = "") Then
                With Range("H" & Cellule_en_Cours.Row)
                    If (Not .Value = "" And (.Value < Range("T4").Value Or .Value > Range("T3").Value)) Or Not .Offset(0, 1).Value = "" Then
                        Do
                        ActiveSheet.Unprotect ("2230")
                            .Offset(0, 1).Value = InputBox(Prompt:="ATTENTION :" & Chr(13) & Chr(10) & "Valeur non-conforme" & Chr(13) & Chr(10) & "Un commentaire est requis")
                        ActiveSheet.Protect ("2230")
                        Loop Until (Not .Offset(0, 1).Value = "" And Not .Offset(0, 1).Value = "FAUX") Or (.Value >= Range("T4").Value And .Value <= Range("T3").Value)
                    End If
                End With
            End If
        Next Cellule_en_Cours
    End If
End Sub

Merci d'avance pour votre aide,

Mickaël

 

[patricktoulon]

Bonjour
ta demande n'est pas très claire
ça veut dire quoi "shunter" pour toi
si tu entends par là que tu ne veux pas que l'on saute l’étape du inputbox met tout simplement un espace par défaut en valeur
d'autant plus que ca fonctionne pas très bien ton truc
et si je me trompe pas l'intention est de forcer un imputbox

pour l'instant tel quel le code de l'events ne fait rien
en plus tu n'a rien pour abandonner si la saisie n'est pas conforme et donc c'est un inputbox sans fin qui reviens

je t'ai donc mis une limite a 4 tentatives a chaque fois
ca te permet de pouvoir sortir sinon tu es bloqué

Dim x As Long
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Cel As Range
    If Not Intersect(Target, Range("E23:G999")) Is Nothing Then
        For Each Cel In Intersect(Target, Range("E23:G999"))
            If Not (Range("E" & Cel.Row) = "" Or Range("F" & Cel.Row) = "" Or Range("G" & Cel.Row) = "") Then
                With Range("H" & Cel.Row)
                    If (Not .Value = "" And (.Value < Range("T4").Value Or .Value > Range("T3").Value)) Or Not .Offset(0, 1).Value = "" Then
                        Do
                            If x = 4 Then MsgBox " 4 tentatives autorisées!! pas plus !!!!!": x = 0: Exit Sub
                            x = x + 1
                            ActiveSheet.Unprotect ("2230")
                            .Offset(0, 1).Value = InputBox(Prompt:="ATTENTION :" & Chr(13) & Chr(10) & "Valeur non-conforme" & Chr(13) & Chr(10) & "Un commentaire est requis", Default:=" ")
                            ActiveSheet.Protect ("2230")
                        Loop Until (.Offset(0, 1).Value = "" And Not .Offset(0, 1).Value = "FAUX") Or (.Value >= Range("T4").Value And .Value <= Range("T3").Value)
                    End If
                End With
            End If
        Next Cel

    End If
End Sub

 

[MickaeL_D]

Bonjour,

Oui je suis conscient le terme "shunter" n'est peut être pas adapté. Dans tous les cas tu as su répondre à ma demande. J'ai modifié la macro comme suit :

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Cellule_en_Cours As Range
    If Not Intersect(Target, Range("E23:G999")) Is Nothing Then
        For Each Cellule_en_Cours In Intersect(Target, Range("E23:G999"))
            If Not (Range("E" & Cellule_en_Cours.Row) = "" Or Range("F" & Cellule_en_Cours.Row) = "" Or Range("G" & Cellule_en_Cours.Row) = "") Then
                With Range("H" & Cellule_en_Cours.Row)
                    If (Not .Value = "" And (.Value < Range("T4").Value Or .Value > Range("T3").Value)) Or Not .Offset(0, 1).Value = "" Then
                        Do
                        ActiveSheet.Unprotect ("2230")
                            .Offset(0, 1).Value = InputBox(Prompt:="ATTENTION :" & Chr(13) & Chr(10) & "Valeur non-conforme" & Chr(13) & Chr(10) & "Un commentaire est requis")
                        ActiveSheet.Protect ("2230")
                        Loop Until (Not .Offset(0, 1).Value = "" And Not .Offset(0, 1).Value = "FAUX" And Not .Offset(0, 1).Value = " ") Or (.Value >= Range("T4").Value And .Value <= Range("T3").Value)
                    End If
                End With
            End If
        Next Cellule_en_Cours
    End If
End Sub

Et cela fonctionne. Je me suis torturé l'esprit pour rien 😉