Soyez le premier à donner votre avis sur cette source.
Snippet vu 16 656 fois - Téléchargée 59 fois
'DECLARATION API Public Declare Function GetWindowLong Lib "user32" _ Alias "GetWindowLongA" _ (ByVal hwnd As Long, _ ByVal nIndex As Long) As Long Public Declare Function SetWindowLong Lib "user32" _ Alias "SetWindowLongA" _ (ByVal hwnd As Long, _ ByVal nIndex As Long, _ ByVal dwNewLong As Long) As Long 'DECLARATION CONSTANTES Public Const GWL_STYLE As Long = -16& Public Const ES_NUMBER = &H2000& Public Sub SetNumber(NumberText As TextBox, Flag As Boolean) Dim curstyle As Long, newstyle As Long 'Récupère le style curstyle = GetWindowLong(NumberText.hwnd, GWL_STYLE) If Flag Then curstyle = curstyle Or ES_NUMBER Else curstyle = curstyle And (Not ES_NUMBER) End If 'Attribue le nouveau style newstyle = SetWindowLong(NumberText.hwnd, GWL_STYLE, curstyle) 'Rafraîchi NumberText.Refresh End Sub
-----
Private Sub txtBox_KeyPress(KeyAscii As Integer)
Select Case KeyAscii
Case 46, 44 ' 46 -> . | 44 -> ,
If InStr(txtBox.Text, ",") > 0 Or InStr(txtBox.Text, ".") > 0 Then KeyAscii = 0
Case Else
If Not Chr(KeyAscii) Like "[0-9,.]" And KeyAscii <> Asc(vbBack) Then KeyAscii = 0
End Select
End Sub
-----
Toutefois, ton code empêche du coup la saisie d'un nombre à virgule, voici une solution simple pour régler le problème :
Dim SvgVirgule As Boolean
Private Sub Form_Load()
SetNumber txtBox, True
SvgVirgule = False
End Sub
Private Sub txtBox_KeyPress(KeyAscii As Integer)
' on empêche de saisir une virgule dans un TextBox vide
If txtBox.Text = "" Then
SvgVirgule = False
Exit Sub
End If
' si on supprime la virgule, on doit pouvoir en remettre une
If KeyAscii = 8 Then
If Right(txtBox.Text, 1) "," Then SvgVirgule False
End If
' on vérifie qu'il n'y a pas déjà une virgule
If KeyAscii 46 Or KeyAscii 44 Then
If SvgVirgule = True Then Exit Sub
End If
' si c un point, on le convertit en virgule
If KeyAscii 46 Then KeyAscii 44
' si c une virgule, on la met
If KeyAscii = 44 Then
SetNumber txtBox, False
SvgVirgule = True
End If
End Sub
Private Sub txtBox_KeyUp(KeyCode As Integer, Shift As Integer)
SetNumber txtBox, True
End Sub
( Vous trouverez bientôt une petite application de ce code - convertisseur Euro/Francs - sur mon site )
Private Sub Text1_KeyUp(KeyCode As Integer, Shift As Integer)
If KeyCode < 96 Or KeyCode > 105 And KeyCode <> vbKeyDecimal Then
Text1 = Mid(Text1, 1, Len(Text1) - 1)
Text1.SelStart = Len(Text1)
End If
End Sub
C bof, mais pour ceux qu'on pas envie de se casser le cul ca peut marcher.
REMARQUE: ca marche pas avec les copiers collés
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.