Date Control and +/-

[blueshark]

I am trying to make a date control on a form that has the fuction that pressing the plus sign increases the date by one day and the minus sign decreases it by one date. The default date is the current date. I'm trying to use the keypress event but I can't seem to figure out how to keep it from sending the plus sign to the date field.

 

[Cbrine]

Blue Shark,
Have you thought about using a spinner control, instead of the keyboard? Press on the up arrow, date increase, press on the down arrow the date decreases? Or is that not an option?

 

[blueshark]

Never heard of a spinner. wuzit? Arrow would work fine.

 

[mdmilner]

Here is how you do it. Insert the first sub as the event triggered by Keypress into the text box. It calls the 2nd sub. Code attribution included but I forget where I got it from (years ago).

Spinner control may still be a good choice.

Mike

Private Sub Date_of_Change_KeyPress(KeyAscii As Integer)

    Call PlusMinus(KeyAscii, "frmChanges", "sfmChanges1")

End Sub

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


'Allows a date or number field on a form or subform to respond to plus/minus keys
'Sample Usages (in the 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        '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