Home
Home

---Soumis par Jason Looney---

Sensibiliser les champs numériques, et de date, aux clés plus et moins.

Parfois, on est intéressé à utiliser les clés + et - comme opérateur pour accroître ou décroître de une unité un champ numérique, ou une date.

Vous pouvez appeler cette fonction, à l'intérieur de la procédure événementielle  KeyPress, du contrôle désiré, pour obtenir l'effet annoncé.

'**************** Code Start **************
'Code Courtesy of
'Jason Looney
'
Public Function PlusMinus(intKey As Integer, strFormName As String, Optional _
    strSubformName As String = "", Optional strSubSubFormName As String = "") _
    As Integer

'Permet d'accroître ou de décroître un champ, d'une unité, par l'utilisation de + ou du -
'Exemple d'utilisation (à l'intérieur du  Keypress event):
'   Call PlusMinus(KeyAscii, Me.Name)
'   Call PlusMinus(KeyAscii, Me.Parent.Name, Me.Name)
'   Call PlusMinus(KeyAscii, Me.Parent.Parent.Name, Me.Parent.Name, Me.Name)

On Error GoTo TheHandler
Dim ctl As Control
    
    If strSubformName <> "" Then
        If strSubSubFormName <> "" Then
            Set ctl = Forms(strFormName).Controls(strSubformName).Form.Controls(strSubSubFormName).Form.ActiveControl
        Else
            Set ctl = Forms(strFormName).Controls(strSubformName).Form.ActiveControl
        End If
    Else
        Set ctl = Forms(strFormName).ActiveControl
    End If
    
    ctl = CDate(ctl)
    
    Select Case intKey
        Case Is = 43        'la clé  '+' 
            ctl = ctl + 1
            intKey = 0
        Case Is = 45        'la clé  '-' 
            ctl = ctl - 1
            intKey = 0
        Case Is = 61        'le  '='/'+' à coté du "backspace" (retour d'un caractère)
            ctl = ctl + 1
            intKey = 0
    End Select
           
ExitHandler:
    PlusMinus = intKey
    Set ctl = Nothing
    Exit Function

TheHandler:
    Select Case Err.Number
        Case Is = 94    'Invalid use of null
        Case Is = 13    'Type mismatch
        Case Else
            MsgBox Err.Number & ":  " & Err.Description
            intKey = 0
    End Select
    Resume ExitHandler
End Function
'**************** Code End  **************