Fonction pour contrôler la saisie des entiers

Version imprimable

27/09/2006, 13h49
Le Pharaon

Fonction pour contrôler la saisie des entiers

Bonjour

Je cherche une fonction qui permet de contrôler la saisie d'entiers (positifs ou négatifs). Celle que j'utilise actuellement ne gére que les entiers positifs.
27/09/2006, 14h15
sovo

on peux avoir le code ??

Citation:

Envoyé par sovo

on peux avoir le code ??

Code:

1
2
3
4
5
6
7
8
Private Sub obltxtKilometrage_KeyPress(Index As Integer, KeyAscii As Integer)
    If KeyAscii <> 8 Then
        If Not IsNumeric(Chr(KeyAscii)) Then
           KeyAscii = 0
           Beep
        End If
    End If
End Sub

Code:

1
2
3
4
5
6
7
 
Private Sub obltxtKilometrage_KeyPress(Index As Integer, KeyAscii As Integer)
    If (keyascii < vbkey0 or keyascii > vbkey9) and keyascii <> 8 and key ascii <> vbkeyminus Then
           KeyAscii = 0
           Beep
    End If
End Sub

27/09/2006, 14h47
Le Pharaon

Merci sovo
Sauf que les expressions comme 888-9996-6699 risquent de passer entre les mailles du filet. En supposant que vbkeyminus = "-" :D

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
Private Sub obltxtKilometrage_KeyPress(Index As Integer, KeyAscii As Integer)
    If (keyascii < vbkey0 or keyascii > vbkey9) and keyascii <> 8 and key ascii <> vbkeyminus Then
           KeyAscii = 0
           Beep
    End If
    if keyascii= vbkeyminus then
             if instr(obltxtKilometrage,"-") then
                     KeyAscii = 0
                     Beep
             end if
    End If
 
End Sub

Maintenant quid de l'utilsateur qui fait un copier/coler sur ton textbox ?
Meme pas de keypress declenché !

Personellement ,Je deconseille l'utilisation de keypress pour tester une saisie. je prefere utiliser l'evenement change

une autre proposition

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Private Sub obltxtKilometrage_KeyPress(Index As Integer, KeyAscii As Integer)
    If (keyascii < vbkey0 or keyascii > vbkey9) and keyascii <> 8 and key ascii <> vbkeyminus Then
           KeyAscii = 0
           Beep
    End If
    if keyascii= vbkeyminus then
             if left(obltxtKilometrage.text,1) = "-" then
                     obltxtKilometrage.text = mid(obltxtKilometrage.text,2,len(obltxtKilometrage.text))
             else
                     obltxtKilometrage.text = "-" & obltxtKilometrage.text
             end if
    End If
 
End Sub

27/09/2006, 18h06
Le Pharaon

Merci
Je teste ensuite je vous dis ce que ça a donné

Merci
J'ai trouvé un vieux code (qu'on m'avait proposé ici même) qui gère en même temps les réels, on peut définir le nombre de chiffres après la virgule.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
Public Function DecControl(KeyAscii As Integer, text As TextBox, 
ByVal NOOFDEC As Integer) As Integer
Dim a As Integer
    If KeyAscii = 8 Then
        DecControl = KeyAscii
        Exit Function
    End If
    If NOOFDEC = 0 Then
        If InStr(1, "0123456789-", Chr(KeyAscii)) = 0 Then
            DecControl = 0
            Exit Function
        Else
            DecControl = KeyAscii
            Exit Function
        End If
    Else
        If InStr(1, "0123456789,-", Chr(KeyAscii)) = 0 Then
            DecControl = 0
            Exit Function
        End If
    End If
 
    If Len(text) - text.SelStart > NOOFDEC And Chr(KeyAscii) = "," Then
        DecControl = 0
        Exit Function
    End If
    If KeyAscii <> 8 Then
    If InStr(1, text, ",") <> 0 And Chr(KeyAscii) = "," Then
        DecControl = 0
        Exit Function
    End If
    Dim pos As Integer
    Dim ret As Integer
    pos = InStr(1, text.text, ",")
    If pos = 0 Then
        If InStr(1, "0123456789,-", Chr(KeyAscii)) = 0 Then
            ret = 0
        Else
            ret = KeyAscii
        End If
    Else
        'IF AFTER DECIMAL
        If text.SelStart + 1 > pos Then
            a = Len(text.text) - InStr(1, text, ",")
            If a >= NOOFDEC Then
                ret = 0
            Else
                ret = KeyAscii
            End If
        Else
            ret = KeyAscii
        End If
    End If
    Else
        ret = KeyAscii
    End If
    DecControl = ret
End Function