Question 80

Comment créer une TextBox numérique ?

Plusieurs solutions existent pour n'autoriser que la saisie de nombres dans un TextBox.

La première consiste à vérifier à la validation (c'est par exemple le cas lorsque le focus quitte le contrôle) si la valeur entrée est exacte. Voici un bout de code l'illustrant :

Private Sub TextBox_Validate(Cancel As Boolean)

    ' Vérifie si la valeur entrée est numérique
    If Not IsNumeric(TextBox.Text) Then
        Cancel = True ' Annule la validation de contrôle
        MsgBox "Veuillez entrer un nombre !"
    End If

End Sub

Cette méthode permet d'ailleurs de vérifier la validité de n'importe quel contenu, numérique ou pas.

Une seconde solution consiste à intercepter les frappes au clavier et d'accepter ou non le caractère qui va être entré dans la zone de texte :

Private Sub TextBox_KeyPress(KeyAscii As Integer)

    ' Si la valeur n'est pas comprise entre 0 et 9 et qu'elle n'est pas un backspace
    If Not ((KeyAscii >= 48 And KeyAscii <= 57) Or KeyAscii = 8) Then
        KeyAscii = 0 'on annule la pression sur la touche
    End If

End Sub

Cette seconde technique s'avère pratique pour n'autoriser que la saisie de nombres entiers. Cependant, lorsque la validation est moins simple, sa mise en oeuvre peut facilement devenir complexe. Par exemple, dans le cas de nombres décimaux, lorsque l'utilisateur entre une virgule, il faut s'assurer que celle-ci n'a pas déjà été entrée. De plus, l'utilisateur a toujours la possibilité de "coller" du texte sans qu'une seule vérification ne soit réalisée sur le contenu. Pour éviter cela, on peut "sous-classer" le contrôle afin d'intercepter les opérations du presse-papier. Voici le code à employer permettant de sous-classer autant de contrôles que l'on veut :

Code à transcrire dans un module :

Option Explicit

' Déclaration des API
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" ( _
   ByVal Hwnd As Long, _
   ByVal nIndex As Long, _
   ByVal dwNewLong As Long) As Long
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" ( _
   ByVal lpPrevWndFunc As Long, _
   ByVal Hwnd As Long, _
   ByVal Msg As Long, _
   ByVal wParam As Long, _
   ByVal lParam As Long) As Long

Private Const GWL_WNDPROC = (-4)
Private Const WM_PASTE = &H302

' Variables utilisée par le programme
Private colScControls As New Collection

Public Sub Subclass(hWindow As Long)

    Dim OldWndProc As Long

    'Si aucun autre contrôle n'est déjà sous-classé
    If IsMemberInCollection("hwnd" & hWindow, colScControls) = False Then
        'Redéfinit la procédure à laquelle les messages doivent être envoyés
        OldWndProc = SetWindowLong(hWindow, GWL_WNDPROC, AddressOf WndProc)
        'Ajoute le pointeur vers l'ancienne procédure à la collection
        colScControls.Add OldWndProc, "hwnd" & hWindow
    End If

End Sub

' Procédure appelé lorsqu'un nouveau message est à traiter
Private Function WndProc(ByVal Hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

    ' Booléen permettant de savoir s'il faut retourner la valeur par défaut ou non
    Dim bReturnOld As Boolean

    bReturnOld = True

    Select Case uMsg ' Utile pour plusieurs messages
        Case WM_PASTE ' Dans le cas où on colle du texte
            If Not IsNumeric(Clipboard.GetText) Then ' Si le texte dans le presse papier n'est pas numérique
                WndProc = 0 ' On renvoie une réponse négative : le texte ne sera pas collé
                bReturnOld = False
            End If
    End Select

    ' Si on ne veut pas redéfinir la valeur retournée, on retourne la valeur que retourne la procédure par défaut
    If bReturnOld Then WndProc = CallWindowProc(colScControls("hwnd" & Hwnd), Hwnd, uMsg, wParam, lParam)

End Function

Public Sub UnSubclass(hWindow As Long)

    ' Si un contrôle a déjà été sous-classé
    If IsMemberInCollection("hwnd" & hWindow, colScControls) Then
        ' Redéfinit la procédure à laquelle les messages doivent être envoyés
        SetWindowLong hWindow, GWL_WNDPROC, colScControls("hwnd" & hWindow)
        ' Supprime la référence à la fenêtre de la collection
        colScControls.Remove "hwnd" & hWindow
    End If

End Sub

Private Function IsMemberInCollection(Member, Collection As Collection) As Boolean

    Dim TempVal As Variant

    On Error Resume Next
    TempVal = Collection(Member)
    IsMemberInCollection = (Err.Number = 0)
    Err.Clear

End Function

Code à transcrire dans une feuille :

Option Explicit

Private Sub Form_Load()

    Subclass Text1.hWnd

End Sub

Private Sub Form_Unload()

    UnSubclass Text1.hWnd

End Sub

Vous trouverez aussi un exemple de sous-classement destiné à intercepter les messages WM_PASTE sur vbVision : LimitEdit Demo.

Attention, si vous terminez votre programme en cliquant sur le bouton "End" (Fin), vous ferez planter VB (à moins de disposer d'une DLL de gestion du sous-classement idoine). Quand on sous-classe un contrôle, il faut toujours terminer son programme en cliquant sur la croix du formulaire principal.

Une troisième solution consiste à vérifier, après la frappe, le texte entré :

Private Sub Text1_Change()

    Dim OldSelStart As Long

    If Not IsNumeric(Text1.Text) Then
        ' Enregistre la position actuelle du curseur dans le Text1
        OldSelStart = Text1.SelStart
        ' Reprend la valeur contenue dans le Text1 ("123b" => 123 ; "b123" => 0)
        Text1.Text = CStr(Val(Text1.Text))
        ' Restaure la position du curseur
        Text1.SelStart = OldSelStart
    End If

End Sub

Cette méthode présente de nombreux désavantages. Notamment, si l'utilisateur appuie par erreur sur la mauvaise touche, il se peut qu'une partie de la valeur introduite soit perdue, le forçant à recommencer la saisie du nombre. De plus, la remise à 0 du texte déclenche à nouveau l'événement Change, ce qui doit être pris en considération si pour des traitements plus complexes, afin d'éviter la répétition du code.

Une quatrième méthode consiste à changer le style du contrôle via une API. Il existe en effet un style (ES_NUMBER) qui n'autorise que la saisie de nombres pour une zone de texte :

Option Explicit

' Déclaration des API
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" ( _
   ByVal hWnd As Long, _
   ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" ( _
   ByVal hWnd As Long, _
   ByVal nIndex As Long, _
   ByVal dwNewLong As Long) As Long

Private Const GWL_STYLE = (-16)
Private Const ES_NUMBER = &H2000&

Private Sub SetNumeric(txtTextBox As textbox, bNumeric As Boolean)

    Dim CurStyle As Long ' Variable de conservation du style actuel
    CurStyle = GetWindowLong(txtTextBox.hWnd, GWL_STYLE) ' Récupère le style actuel

    If bNumeric Then ' S'il faut le rendre numérique
        ' On applique la constante au style actuel
        SetWindowLong txtTextBox.hWnd, GWL_STYLE, CurStyle Or ES_NUMBER
    Else
        ' On enlève la constante du style actuel
        SetWindowLong txtTextBox.hWnd, GWL_STYLE, CurStyle And (Not ES_NUMBER)
    End If

End Sub

' Exemple d'utilisation
Private Sub Command1_Click()

    SetNumeric Text1, True

End Sub

Malheureusement, ce style n'accepte que les nombres entiers et n'empêche pas l'utilisateur a de "coller" du texte sans vérification. Il faudra donc mettre en place la technique de sous-classement évoquée ci-dessus.

Enfin une dernière méthode serait d'employer un contrôle "MaskedEditBox" qui permet de spécifier un masque de saisie pour les données à entrer. Mais ce contrôle n'est pas toujours facile à manipuler et est assez buggé. Cette méthode est donc à déconseiller.

Pour conclure, quelle que soit la méthode choisie, sachez qu'il vaut toujours mieux vérifier une dernière fois les données avant de les sauvegarder définitivement.

Voir aussi :

• Comment déterminer si ma chaine de caractères est un nombre ?
• Comment valider des données complexes?