Modifier code interdire entrée des chiffres Fermé

Question

Windows 10/ Edge 80.0.361.69 Bonjour a tous , forum bonjour Juste un petit soucis qui me prends la tète car je n'arrive pas dans le code ci-dessous récupérer sur le net de modifier les entrées dans la colonne (H2:H90) Donc le but: serai d'autoriser que les chiffres de 0 à 99 avec le format ci-dessous 1 chiffre minimum et 2 chiffres maximum - cellule vide non interdit - 0 tout seul non interdit - 00 deux zéros non interdit - 01 zéro devant non interdit - 02 zéro devant non interdit - 5 oui Ok - 8 oui Ok - 22 oui Ok - 30 oui Ok - 50 oui Ok - 99 oui Ok Private Sub Worksheet_Change(ByVal Target As Range) Dim sRange As Range, sCell As Range, temp If Not Intersect(Target, Range("A2:H90")) Is Nothing Then Cells(Target.Row, "H").Select '*** Positionne curseur en colonne (H) '# # # # # TEST DES ENTREES NUMERIQUE de 1 à 99 AUTORISER Set sRange = Range("H2:H90") '*** Zone de saisie If Not Intersect(Target, sRange) Is Nothing Then '*** Vérifie seulement les cellules modifiées dans la plage de saisie For Each sCell In Intersect(Target, sRange) If sCell <> "" Then '*** Ignore les cellules vides If Not IsNumeric(sCell) Then '*** Non numérique CreateObject("Wscript.shell").Popup "Erreur cellule [" & sCell.Address(False, False) & "] :Non numérique", 2, vbInformation '******* Else '*** Controle des 2 chiffres If Left(temp, 1) = "0" Then Cells(Target.Row, "H") = "" '*** Efface le zéro si il est seul temp = CStr(sCell.Value) '*** Donc 12345 = Ok, 1.2345 = Ok aussi temp = Replace(temp, ",", "", , , vbTextCompare) '*** Supprime les virgules temp = Replace(temp, ".", "", , , vbTextCompare) If Len(temp) > 2 Then '*** 2 chiffres maximum CreateObject("Wscript.shell").Popup "Erreur cellule [" & sCell.Address(False, False) & "] : 2 chiffres maximum", 2, vbInformation '******* ElseIf Left(temp, 1) = "0" Then Target = CInt(Right(temp, 1)) '*** Supprime le premier zéro End If End If End If Next sCell End If End Sub Merci pour votre aide et bonne après midi a vous. Cdlt Dudulle

ThauTheme · Answer

Bonjour Dudulle, bonjour le forum,

Peut-être comme ça :
Private TEST As Boolean

Private Sub Worksheet_Change(ByVal Target As Range)
Dim MSG As String

If Intersect(Target, Range("H2:H90")) Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub
If TEST = True Then Exit Sub
MSG = "Entrée non valide ! Veuillez recommencez."
Select Case Len(Target.Value)
    Case Is > 2
        TEST = True: Target.ClearContents: MsgBox MSG
    Case 2
        If Target.Value = "00" Then TEST = True: Target.ClearContents: MsgBox MSG: Target.Select
        If Left(Target.Value, 1) = "0" Then Target.Value = Right(Target.Value, 1): TEST = False
        If IsNumeric(Target.Value) = False Then Target.Value = ClearContents: MsgBox MSG: Target.Select: TEST = False
    Case 1
        If Target.Value = "0" Then TEST = True: Target.ClearContents: MsgBox MSG: Target.Select
        If IsNumeric(Target.Value) = False Then Target.Value = ClearContents: MsgBox MSG: Target.Select
End Select
If Target.Value = "" Then MsgBox "Seules sont autorisées les valeurs entières de 1 à 99": Target.Select: TEST = False
End Sub

Patrice33740 · Answer

Bonjour,

Pourquoi passer par du VBA quand une simple validation de données (nombre entier de 1 à 99) est 
suffisante !
Exemple : https://mon-partage.fr/f/IKDtNIiT/

yg_be · Answer

bonjour,
tu ne l'écris pas, mais je suppose que tu veux réagir au moment où une cellule est modifiée, et corriger cette cellule.
je pense que les lignes 4 et 5 ne servent à rien.
l'indentation de ton code n'est pas conforme, cela n'aide pas à le comprendre.
en ligne 18, tu utilises temp, alors que tu n'y a rien mis.
j'ai l'impression que tu utilises des nombres comme si c'était du texte.
comme tu fais une boucle avec sCell, il ne faut plus utiliser Target dans cette boucle.
commence par faire un cas simple, par exemple remplacer 2 par 3, cela t'aidera à comprendre.

duduleray · Answer

Salut yg_be,

merci pour ta réponse, c'est sympa.

Effectivement pour l'indentation, je n'ai plus le programme "INDENTER" qui faisait ça.
Je vais essayer de le retrouver et le réinstaller.

Tu ne l'écris pas, mais je suppose que tu veux réagir au moment où une cellule est modifiée, et corriger cette cellule.
Réponse: oui c'est bien ça.

Le premier code n'ai pas de moi et j'ai juste mis le code ci-dessous que je trouve bien car c'est paramétrable le message disparait automatiquement, nul besoin de cliquer sur "Ok"

CreateObject("Wscript.shell").Popup "Erreur cellule [" & sCell.Address(False, False) & "] :Non numérique", 2, vbInformation

je n'ai pas toucher aux tests

Donc ça ne fonctionne pas comme je le souhaitais.

Bonne après midi a toi, merci.

PS: d'ailleurs je viens d'essayer a nouveau le code de l'ami ThauTheme qui ne fonctionne pas non plus trouver d'autres erreurs.

Cdlt dudulle

ThauTheme · Answer

Bonjour le fil, bonjour le forum,

En effet la ligne 19 est une ineptie : Target.Value = Clearcontents ! À remplacer bien évidemment par : Target.ClearContents et ne pas oublier la ligne 1 hors macro en début du module.
Pour ma part les quelques tests que j'ai fait, sur les cellules H2 à H90, étaient satisfaisant.
Le code corrigé :
Private TEST As Boolean

Private Sub Worksheet_Change(ByVal Target As Range)
Dim MSG As String

If Intersect(Target, Range("H2:H90")) Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub
If TEST = True Then Exit Sub
MSG = "Entrée non valide ! Veuillez recommencez."
Select Case Len(Target.Value)
    Case Is > 2
        TEST = True: Target.ClearContents: MsgBox MSG
    Case 2
        If Target.Value = "00" Then TEST = True: Target.ClearContents: MsgBox MSG: Target.Select
        If Left(Target.Value, 1) = "0" Then Target.Value = Right(Target.Value, 1): TEST = False
        If IsNumeric(Target.Value) = False Then Target.Value = ClearContents: MsgBox MSG: Target.Select: TEST = False
    Case 1
        If Target.Value = "0" Then TEST = True: Target.ClearContents: MsgBox MSG: Target.Select
        If IsNumeric(Target.Value) = False Then Target.ClearContents: MsgBox MSG: Target.Select
End Select
If Target.Value = "" Then MsgBox "Seules sont autorisées les valeurs entières de 1 à 99": Target.Select: TEST = False
End Sub

Modifier code interdire entrée des chiffres

5 réponses

Discussions similaires