excelvbauserform

Keep focus on textbox after pressing the down arrow


I am trying to have the up and down arrows change the value of a textbox in my userform when pressed.

The userform looks like this

Picture of the userform

and the code for it looks like this

Option Explicit

Private cancelled As Boolean
Private current_week As Long
Private current_year As Long
Private weeks_in_year As Long
 
Public Property Get IsCancelled() As Boolean
    IsCancelled = cancelled
End Property

Private Sub spbÅr_Change()
    If Me.spbÅr.Value = 2102 Then Me.spbÅr.Value = 2001
    If Me.spbÅr.Value = 2000 Then Me.spbÅr.Value = 2101
    
    weeks_in_year = DatePart("ww", DateSerial(current_year, 12, 28), vbMonday, vbFirstFourDays)
    
    Me.tbxÅr = Me.spbÅr.Value
End Sub

Private Sub spbVeke_Change()
    If Me.spbVeke.Value = weeks_in_year + 1 Then Me.spbVeke.Value = 1
    If Me.spbVeke.Value = 0 Then Me.spbVeke.Value = weeks_in_year
    
    Me.tbxVeke = Me.spbVeke.Value
End Sub

Private Sub tbxÅr_Change()
    If Me.tbxÅr >= 2102 Then Me.tbxÅr = 2101
    If Me.tbxÅr <= 2000 Then Me.tbxÅr = 2001
    
    Me.spbÅr = Me.tbxÅr.Value
    
    sjekk_om_utfylt
End Sub

Private Sub tbxVeke_Change()
    If Me.tbxVeke >= weeks_in_year Then Me.tbxVeke = weeks_in_year
    If Me.tbxVeke <= 0 Then Me.tbxVeke = 1
    
    Me.spbVeke = Me.tbxVeke.Value
    
    sjekk_om_utfylt
End Sub
' Prevent anything but numbers in the textbox
Private Sub tbxÅr_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    With Me.tbxÅr
        Select Case KeyCode
            Case vbKeyDown:
                .Value = .Value - 1
                .SetFocus
            Case vbKeyUp:
                .Value = .Value + 1
                .SetFocus
            Case Is < 48, Is > 57:
                KeyCode = 0
        End Select
    End With
End Sub

Private Sub tbxVeke_KeyPress(ByVal KeyCode As MSForms.ReturnInteger)
    If KeyCode >= 48 And KeyCode <= 57 Then
    Else
        KeyCode = 0
    End If
End Sub

Private Sub tbxVeke_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    With Me.tbxVeke
        Select Case KeyCode
            Case vbKeyDown:
                .Value = .Value - 1
                .SetFocus
            Case vbKeyUp:
                .Value = .Value + 1
                .SetFocus
        End Select
    End With
End Sub

Private Sub UserForm_Initialize()
    current_week = Application.WorksheetFunction.IsoWeekNum(Date)
    current_year = Year(Date)
    weeks_in_year = DatePart("ww", DateSerial(current_year, 12, 28), vbMonday, vbFirstFourDays)
    
    If current_week + 1 > weeks_in_year Then
        Me.tbxVeke = 1
        Me.tbxÅr = current_year + 1
    Else
        Me.tbxVeke.Value = current_week + 1
        Me.tbxÅr.Value = current_year
    End If
    
    sjekk_om_utfylt
    
    Me.tbxVeke.SetFocus
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    If CloseMode = VbQueryClose.vbFormControlMenu Then
        Cancel = True
        OnCancel
    End If
End Sub
 
Private Sub cmdOK_Click()
    Me.Hide
End Sub
 
Private Sub cmdAvbryt_Click()
    OnCancel
End Sub

Private Sub sjekk_om_utfylt()
    cmdOK.Enabled = CBool(Len(Me.tbxVeke) > 0 And Len(Me.tbxÅr) > 0)
End Sub

Private Sub OnCancel()
    cancelled = True
    Me.Hide
End Sub

As you can see I have tried two different methods for input validation / detecting the up- / down-arrows, but in both of the text boxes I run into the same issue: When using the down arrow, the value decrement by one correctly, but the focus switches to the "OK" button (this is the default button for the form). Using the up-arrow keeps the focus in the textbox correctly.

Can anyone help me with how to keep the focus on the textbox? As you can see I tried adding and extra SetFocus statement too, without any luck


Solution

  • You can get by with just the KeyDown event. Instead of trying to set focus back to the control, simply set the KeyCode to zero.

    Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
        With Me.TextBox1
            Select Case KeyCode
                Case vbKeyDown:
                    .Value = .Value - 1
                    KeyCode = 0
                Case vbKeyUp:
                    .Value = .Value + 1
                    KeyCode = 0
                Case Is < 48, Is > 57:
                    KeyCode = 0
            End Select
        End With
    End Sub