Remap keys while form is active

[KB_Miner]

I'm looking for a way for my code to remap Ctrl + T to the right arrow key while a form is running. I'd like to use that key combo to be able to move inside a DTPicker that's set to a time format. I've tried using Application.Onkey, but maybe my syntax isn't quite right. I'm trying Application.OnKey "^{T}","{RIGHT}" when the user form activates, then Application.OnKey "^{T}" when the form is closed to reset it. Is my syntax wrong, or is there a better way to do that?

 

[KB_Miner]

I made some progress by removing the {} from around the T, but now Excel is telling me that it can't run the macro "File name!{Right}" The macro may not be available in this workbook or all macros may be disabled. I tried changing the "{Right}" argument to a Public Sub called moveselection that used SendKey {Right} and got the same error. However, if I went to the View Macros menu and ran moveselection by itself, it would work.

 

[Jaafar Tribak]

OnKey is a Method of the Excel.Application Object so it won't work with UserForms.

I don't have a DatePicker control installed as I use x64bit excel so I can't carry out any testings.

Does the DatePicker control object model has a Property or method to select the element (ie:== the date) that is next to the current date ?

If you know that Method or property, I can try and write some example for you.

 

[Jaafar Tribak]

Meanwhile, you can try the following code and see how it goes :

In the Userfome module:

Option Explicit

Private Type POINTAPI
    x As Long
    y As Long
End Type


#If VBA7 Then
    Private Type MSG
        hwnd As LongPtr
        message As Long
        wParam As LongPtr
        lParam As LongPtr
        time As Long
        pt As POINTAPI
    End Type
    Private Declare PtrSafe Function RegisterHotKey Lib "user32" (ByVal hwnd As LongPtr, ByVal id As Long, ByVal fsModifiers As Long, ByVal vk As Long) As Long
    Private Declare PtrSafe Function UnregisterHotKey Lib "user32" (ByVal hwnd As LongPtr, ByVal id As Long) As Long
    Private Declare PtrSafe Function PeekMessage Lib "user32" Alias "PeekMessageA" (lpMsg As MSG, ByVal hwnd As LongPtr, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long, ByVal wRemoveMsg As Long) As Long
    Private Declare PtrSafe Function WaitMessage Lib "user32" () As Long
    Private Declare PtrSafe Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
    Private Declare PtrSafe Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
#Else
    Private Type MSG
        hwnd As Long
        message As Long
        wParam As Long
        lParam As Long
        time As Long
        pt As POINTAPI
    End Type
    Private Declare Function RegisterHotKey Lib "user32" (ByVal hwnd As Long, ByVal id As Long, ByVal fsModifiers As Long, ByVal vk As Long) As Long
    Private Declare Function UnregisterHotKey Lib "user32" (ByVal hwnd As LongPtr, ByVal id As Long) As Long
    Private Declare Function PeekMessage Lib "user32" Alias "PeekMessageA" (lpMsg As MSG, ByVal hwnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long, ByVal wRemoveMsg As Long) As Long
    Private Declare Function WaitMessage Lib "user32" () As Long
    Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
    Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
#End If


Private Const MOD_CONTROL = &H2
Private Const PM_REMOVE = &H1
Private Const WM_HOTKEY = &H312
Private bCancel As Boolean

Private Sub UserForm_Activate()
    Trap_CTRL_T True
End Sub

Private Sub UserForm_Terminate()
    Trap_CTRL_T False
End Sub


Public Sub Trap_CTRL_T(ByVal Yes As Boolean)
    bCancel = Not Yes
    If Yes Then
        Call RegisterHotKey(0, &HBFFF&, MOD_CONTROL, vbKeyT)
        ProcessMessages
    Else
        Call UnregisterHotKey(0, &HBFFF&)
    End If
End Sub

Private Sub ProcessMessages()
    Dim message As MSG
    Do While Not bCancel
        WaitMessage
            If PeekMessage(message, 0, WM_HOTKEY, WM_HOTKEY, PM_REMOVE) Then
                   Call NavigateDTPicker
            End If
        DoEvents
    Loop
End Sub


Private Sub NavigateDTPicker()
    If TypeName(Me.ActiveControl) = "DTPicker" Then
        SendKeys "{RIGHT}"
    End If
End Sub

 

[KB_Miner]

Jaafar, thanks for the code, but it didn't have the desired effect. Could we manipulate the active control within the form with a KeyDown event? Something like:

Private Sub UserForm_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If Me.ActiveControl = DTPicker2 Then
If Shift = 2 And KeyCode = vbKeyT Then
    SendKeys ("{Right}")
End If
End If
End Sub

 

[KB_Miner]

I was able to get it working by setting it to the DTPicker2 Key Down instead of the User Form. Here's my code:

Private Sub DTPicker2_KeyDown(KeyCode As Integer, ByVal Shift As Integer)
If Shift = 2 And KeyCode = vbKeyT Then
    SendKeys ("{Right}")
End If
End Sub