Interdire le premier chiffre 0
Bonjour a tous , forum bonjour
Juste un petit soucis qui me prends la tète je n'arrive pas dans le code ci-dessous récupérer sur le site a
interdire le premier zéro.
Dans la cas présent 1 ou 2 chiffres sont autoriser maxi.
Mais le premier zéro m'ennuie.
Donc le but:
01 non interdit
02 non interdit
5 oui Ok
8 oui Ok
22 oui Ok
30 oui Ok
50 oui Ok
Une petite correction s'impose mais je sèche depuis un bon moment.
Alors un petit coup de main svp pour adapter le code m'aiderai bien.
Merci pour votre aide et bonne après midi a vous.
Cdlt Ray
Private Sub Worksheet_Change(ByVal Target As Range)
Dim sRange As Range, sCell As Range, temp
Set sRange = Range("H2:H90") 'zone de saisie
If Not Intersect(Target, sRange) Is Nothing Then
' verifie 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 numerique
MsgBox "Erreur cellule [" & sCell.Address(False, False) & "] : non numerique"
Else ' controle des 2 chiffres
' donc 12345 = ok, 1.2345 = ok aussi
temp = CStr(sCell.Value)
' supprime les virgules
temp = Replace(temp, ",", "", , , vbTextCompare)
temp = Replace(temp, ".", "", , , vbTextCompare)
If Len(temp) > 2 Then ' 2 chiffres exactement
MsgBox "Erreur cellule [" & sCell.Address(False, False) & "] : 2 chiffres max"
End If
End If
End If
Next sCell
End If
End Sub
Bonjour eliot raymond,
Essaye comme ceci:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim sRange As Range, sCell As Range, temp
Set sRange = Range("H2:H90") 'zone de saisie
If Not Intersect(Target, sRange) Is Nothing Then
' verifie 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 numerique
MsgBox "Erreur cellule [" & sCell.Address(False, False) & "] : non numerique"
Else ' controle des 2 chiffres
' donc 12345 = ok, 1.2345 = ok aussi
temp = CStr(sCell.Value)
' supprime les virgules
temp = Replace(temp, ",", "", , , vbTextCompare)
temp = Replace(temp, ".", "", , , vbTextCompare)
If Len(temp) > 2 Then ' 2 chiffres exactement
MsgBox "Erreur cellule [" & sCell.Address(False, False) & "] : 2 chiffres max"
ElseIf Left(temp, 1) = "0" Then Target = cint(Right(temp, 1))
End If
End If
End If
Next sCell
End If
End Sub
Bonjour,
Ta demande n'est pas des plus claires ...
Je me contenterais de :
Private Sub Worksheet_Change(ByVal Target As Range)
Dim sRange As Range, sCell As Range
Set sRange = Range("H2:H90")
If Not Intersect(Target, sRange) Is Nothing Then
For Each sCell In Intersect(Target, sRange)
If sCell <> "" Then
If CStr(Val(sCell.Value)) <> sCell.Text And Len(sCell.Text) < 3 Then
MsgBox "Erreur cellule [" & sCell.Address(False, False) & "] : hors format"
End If
End If
Next sCell
End If
End Sub
Bonjour,
Petite question :
Avec Excel le premier 0 "n'existe pas" sauf à travailler avec du texte, non ?
Et s'il est affiché par une mise en forme personnalisé, alors on le voit mais il n'existe pas non plus, non ?
Du coup pourquoi le chercher ?
Et si les deux chiffres font partie d'un décimal inférieur à 1, par exemple 0,5 doit il disparaître ?
@ bientôt
LouReeD
Salut a vous,
Merci pour les réponses, c'est sympa a vous.
Après essai, j'opte pour le code de Florian53 que je comprends bien et fonctionne très bien.
Merci a vous tous pour votre aide et votre savoir partager.
Je vous souhaite une bonne après midi et merci pour réactivité.
Bien cordialement Ray