Modifier code interdire entrée des chiffres

duduleray -  
 duduleray -
<config>Windows 10/ Edge 80.0.361.69</Excel 2007>

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
A voir également:

5 réponses

Réponse 1 / 5
ThauTheme Messages postés 1442 Date d'inscription   Statut Membre Dernière intervention   160
 
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

1
duduleray
 
Salut ThauTheme,

Merci pour ta réponse et pour la modification du code.

J'ai une erreur a chaque ligne 
Target.Value = ClearContents
qui me génère " erreur de compilation & variable non définie".

Quand j'entre un chiffre qu'il soit bon ou mauvais, j'ai tous les messages qui s'affichent les uns après les autres.

Merci a toi et bonne après midi.

Cdlt dudulle
0
Réponse 2 / 5
Patrice33740 Messages postés 8561 Date d'inscription   Statut Membre Dernière intervention   1 780
 
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/

1
Réponse 3 / 5
yg_be Messages postés 23541 Date d'inscription   Statut Contributeur Dernière intervention   Ambassadeur 1 584
 
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.
1
Réponse 4 / 5
ThauTheme Messages postés 1442 Date d'inscription   Statut Membre Dernière intervention   160
 
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
1
duduleray
 
Re ThauTheme,

Merci pour la modification.
Mais quand je test de cette façon Ex:

Si j'entre dans la cellule un zéro 0 je valide par Enter comme ce n'ai pas bon, la cellule s"efface
et j'ai le message "Entrée non valide ! Veuillez recommencer" qui s'affiche, je fais ok dans le message, il s"efface
Puis un autre message s'affiche "Seules sont autorisées de 1 à 99" je fais de nouveau ok le message s"efface
et je peux corriger.

Et exactement la même chose quand j'entre deux zéros 00 ou bien si j'entre 3 chiffres 251 .

Voila je te remercie beaucoup pour ton aide.

Cdlt Dudulle
0
ThauTheme Messages postés 1442 Date d'inscription   Statut Membre Dernière intervention   160 > duduleray
 
Ben, ça fonctionne alors !... Tu voudrais quoi ? Je ne comprends pas où se situe le problème...
0
duduleray > ThauTheme Messages postés 1442 Date d'inscription   Statut Membre Dernière intervention  
 
Salut ThauTheme,

Merci pour la réponse,

J'ai du mal m'exprimer, en fait je ne veux pas autoriser l'entrée de un zéro , ni l'entrée de deux zéros , ni plus de deux chiffres, seul les chiffres de 1 à 99 me sont utiles

au mieux le signe (-) et (+) on peux interdire aussi

Merci pour ton aide, vu l'heure bon app a toi

Cdlt Dudulle
0
Patrice33740 Messages postés 8561 Date d'inscription   Statut Membre Dernière intervention   1 780 > duduleray
 
Finalement tu veux une validation de données pour un nombre entier de 1 à 99, c'est ce que je t'ai proposé ici (sans macro), l'as-tu essayé ?
0
ThauTheme Messages postés 1442 Date d'inscription   Statut Membre Dernière intervention   160 > Patrice33740 Messages postés 8561 Date d'inscription   Statut Membre Dernière intervention  
 
Re,

Oui Patrice, je suis comme toi, il me semble que c'est la solution la plus évidente et la plus simple.
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Réponse 5 / 5
duduleray
 
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
0

Discussions similaires

Toutes les combinaisons à 4 chiffres de 0000 a 9999
Sarah -
baladur13 -

11 réponses
Tous les code possible de 0 à 9 (4 chiffres )
anonymeN1 -
anonymeN1 -

3 réponses