Create keyboard shortcut from userform

[rutger]

Hey there,
A quick question.
Is it possible to create a keyboard shortcut to switch between 2 userforms.
I want to do this because i don't want users to have this option but it would make it easier for me to maintain the workbook. I don't know if this matters but when the userforms are shown, excel is hidden.

Thanks in advance for any help on this,

Greetz,
Rutger

 

[erik.van.geit]

Hello, Rutger,
try this
using doubleclick on the form
FORM1

Private Sub UserForm_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
If Application.UserName <> "Rutger" Then Exit Sub
UserForm1.Hide
UserForm2.Show
End Sub

FORM2

Private Sub UserForm_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
If Application.UserName <> "Rutger" Then Exit Sub
UserForm2.Hide
UserForm1.Show
End Sub

kind regards,
Erik
EDIT: check your username with
Range("A1") = Application.UserName

 

[rutger]

Hi Erik,

Thanks for the quick reply.
Your solution is partially usefull but it's still depending on a username.
My idea was to create the possibility to show that form form no matter what username by somekind of difficult keaboard shortcut.
That way we can always get to the form when helping people without having to close the application and logon again.
I hope this makes sence,

Thanks again,
Rutger

 

[erik.van.geit]

Rutger,
that's another story
then use some "cipher-events-code"
the follwing is just to get the idea
(you can create something completely different)
clicking on button 2 within a second (or more difficult between 0,5 and 1,5 sec: see quoted line) after clicking button 1 will get you an acces to the exit
now doubleclicking the form will get ou out...

options:
playing with some buttons and resetting the "go", playing with timeintervals which the user cannot reproduce, adding a condition like "textbox 1 has "a"

Option Explicit

Dim StartTime As Variant

Private Sub CommandButton1_Click()
StartTime = Timer
End Sub

Private Sub CommandButton2_Click()
'If Round(Timer - StartTime) = 1 Then
If Timer - StartTime < 1 Then
StartTime = "go"
End If
End Sub

Private Sub UserForm_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
If StartTime <> "go" Then Exit Sub
UserForm1.Hide
UserForm2.Show
End Sub

have a happy time
Erik

 

[rutger]

Thanks erik,

I'll have look at this.

Greetz,
Rutger

 

[Jaafar Tribak]

Rutger,

Here is another take that does just what you want and that is to Show and Hide the two UserForms via a KeyBoard shortcut .I've chosen the key combination ALT + SHIFT

Maybe,overkill but was fun to code !

Place this in a Standard Module :

Option Explicit

Declare Function SetWindowsHookEx Lib _
"user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, _
ByVal hmod As Long, ByVal dwThreadId As Long) As Long

Declare Function CallNextHookEx Lib "user32" _
(ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long

Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long

Declare Function GetActiveWindow Lib "user32" () As Long

Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer

Declare Function SetFocus Lib "user32" (ByVal hWnd As Long) As Long

Const HC_ACTION = 0
Const VK_ALT = &H12
Const VK_SHIFT = &H10
Const WH_KEYBOARD_LL = 13
Dim hhkLowLevelKybd As Long
Dim lngFormHndl As Long
Dim blnHookEnabled As Boolean


Public Function LowLevelKeyboardProc _
(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

    If (nCode = HC_ACTION) Then
    
            'If the ALT and SHIFT Keys are simultanously pressed then
            'show the other UserForm
            If (GetKeyState(VK_ALT) And &H8000) And (GetKeyState(VK_SHIFT) _
                And &HF0000000) Then
                
                'Check if there is a loaded Form
                lngFormHndl = FindWindow("ThunderDFrame", vbNullString)

                ' If so is it Form1 or Form2 ?...If either Set Focus to it
                If lngFormHndl = FindWindow(vbNullString, UserForm1.Caption) Or _
                lngFormHndl = FindWindow(vbNullString, UserForm2.Caption) Then
                    SetFocus lngFormHndl
                End If
                
                'Check Which UserForm Is Active and hide it
                Select Case GetActiveWindow
                    Case Is = FindWindow(vbNullString, UserForm1.Caption)
                        UserForm1.Hide
                        UserForm2.Show
                    Case Is = FindWindow(vbNullString, UserForm2.Caption)
                        UserForm2.Hide
                        UserForm1.Show
                End Select
            
            End If
    End If

    ' Call next Hook if there is one.
    LowLevelKeyboardProc = CallNextHookEx(0, nCode, wParam, ByVal lParam)
    
End Function


Public Sub Hook_KeyBoard()

    'Hide XL and VBE
    Application.Visible = False
    Application.VBE.MainWindow.Visible = False
    If blnHookEnabled = False Then
        hhkLowLevelKybd = SetWindowsHookEx _
        (WH_KEYBOARD_LL, AddressOf LowLevelKeyboardProc, Application.Hinstance, 0)
        blnHookEnabled = True
    End If
    
End Sub


 Public Sub Unhook_KeyBoard()
 
    'Show XL
    Application.Visible = True
    If hhkLowLevelKybd <> 0 Then UnhookWindowsHookEx hhkLowLevelKybd
    blnHookEnabled = False
    
End Sub

Place this code in BOTH UserForms Modules:

Private Sub UserForm_Activate()
    Hook_KeyBoard
End Sub

Private Sub UserForm_Terminate()
    On Error Resume Next
    Unload UserForm1: Unload UserForm2
    Unhook_KeyBoard
End Sub

Now, just display either of the UserForms and try hitting the SHIFT Key while holding the ALT key down .This will alternatively hide and show the two UserForms.

Note that I am assuming the UserForms are named respectively UserForm1 and UserForm2. You will need to adapt these names in the code to suit your own scenario.

As you can see, this code uses a System Hook which can be dangerous so please save your work before trying this code or editing it.

Regards.