Forms: Sensibiliser les champs numériques, et de date, aux clés plus et moins	Author(s) 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 de modifier unitairement un champ numérique ou une date avec les clés + et -
'Exemple d'utilisation (dans la procédure événementielle KeyPress):
'   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        'the '+' key
            ctl = ctl + 1
            intKey = 0
        Case Is = 45        'the '-' keys
            ctl = ctl - 1
            intKey = 0
        Case Is = 61        'the '='/'+' key next to Backspace
            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  **************