application.onkey using userform

ktab · Dec 17, 2006

Hello,

I'm trying to assing keyboard shortcuts to my userform using .onkey event.
At initialize event of userform it's:
Application.OnKey"{f3}","test"

module:
sub test()
msgbox"ok"
end sub

Pressing F3 gives me nothing. Doesn't work with userforms?

Thank you
Kostas

Legacy 98055 · Dec 17, 2006

Excel must have the focus for Application.OnKey to function. You can capture keystrokes using your various controls using KeyCode = 114 in your various controls KeyDown event. If you have any controls on your userform that can recieve focus, the KeyDown event of the userform is rendered useless. There is no KeyPreview property in VBA. You will have to use the KeyDown event for each and every control on your form.

ktab · Dec 17, 2006

I was afraid of that

Thank you any way

Legacy 98055 · Dec 17, 2006

Ktab.

What type of controls are on your userform? Textboxes? Buttons? Labels? ect... It's not a big deal to mock a userform keypreview as long as the controls you are using source events...

ktab · Dec 19, 2006

Almost all regular types of controls plus toolbar & date picker (activeX). Almost all read / write to specific ranges, but not linked with ranges using .controlsource.
Even if it cannot be done in this userform, it would be interesting to know how

Legacy 98055 · Dec 19, 2006

Here is a very simple example. In the real world, I would create a separate type for each type of control abd allow you to pass an array or filter. You only need to deal with controls that can recieve the focus. Controls such as the label do not have a keydown event because they cannot accept the focus. The toolbar can actually recieve the focus but it is rare. Usually you have to set the focus to this control via code.

VBAKeyPreview.zip

Userform1 with:
TextBox1
OptionButton1
ListBox1
DTPicker1
Label1
ToolBar1

This code in the uf:
<table width="100%" border="1" bgcolor="White" style="filter

rogid:DXImageTransform.Microsoft.Gradient(endColorstr='#C0CFE2', startColorstr='#FFFFFF', gradientType='0');"><tr><TD> Option Explicit

 Dim WithEvents kp As KeyPreview

 Private Sub UserForm_Initialize()
 Set kp = New KeyPreview
 kp.AddToPreview Me, 114
 End Sub

 Private Sub kp_KeyDown(ByVal KeyCode As Integer, ByVal Shift As Integer)
 MsgBox "F3 was pressed..."
 End Sub
</td></tr></table><button onclick='document.all("1219200620233343").value=document.all("1219200620233343").value.replace(/ \s\s/g,"");document.all("1219200620233343").value=document.all("1219200620233343").value.replace(/ /g,"");window.clipboardData.setData("Text",document.all("1219200620233343").value);'>Copy to Clipboard</BUTTON><textarea style="position:absolute;visibility:hidden" name="1219200620233343" wrap="virtual">
Option Explicit

Dim WithEvents kp As KeyPreview

Private Sub UserForm_Initialize()
Set kp = New KeyPreview
kp.AddToPreview Me, 114
End Sub

Private Sub kp_KeyDown(ByVal KeyCode As Integer, ByVal Shift As Integer)
MsgBox "F3 was pressed..."
End Sub</textarea>

This code in a class module named "KeyPreview":
<table width="100%" border="1" bgcolor="White" style="filter

rogid:DXImageTransform.Microsoft.Gradient(endColorstr='#C0CFE2', startColorstr='#FFFFFF', gradientType='0');"><tr><TD> Option Explicit

 Dim WithEvents u As MSForms.UserForm
 Dim WithEvents t As MSForms.textbox
 Dim WithEvents ob As MSForms.OptionButton
 Dim WithEvents lb As MSForms.ListBox
 Dim WithEvents dp As MSComCtl2.DTPicker

 Event KeyDown(ByVal KeyCode As Integer, ByVal Shift As Integer)
 'Event KeyPress(ByVal KeyAscii As Integer)

 Private FireOnThisKeyCode As Integer

 Friend Sub AddToPreview(Parent As UserForm, KeyCode As Integer)
 Dim c As Control
 Set u = Parent
 FireOnThisKeyCode = KeyCode
 For Each c In Parent.Controls
 Select Case TypeName(c)
 Case "TextBox"
 Set t = c
 Case "OptionButton"
 Set ob = c
 Case "ListBox"
 Set lb = c
 Case "DTPicker"
 Set dp = c
 End Select
 Next c
 End Sub

 Private Sub u_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
 If KeyCode = FireOnThisKeyCode Then RaiseEvent KeyDown(KeyCode, Shift)
 End Sub

 Private Sub t_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
 If KeyCode = FireOnThisKeyCode Then RaiseEvent KeyDown(KeyCode, Shift)
 End Sub

 Private Sub ob_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
 If KeyCode = FireOnThisKeyCode Then RaiseEvent KeyDown(KeyCode, Shift)
 End Sub

 Private Sub lb_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
 If KeyCode = FireOnThisKeyCode Then RaiseEvent KeyDown(KeyCode, Shift)
 End Sub

 Private Sub dp_KeyDown(KeyCode As Integer, ByVal Shift As Integer)
 If KeyCode = FireOnThisKeyCode Then RaiseEvent KeyDown(KeyCode, Shift)
 End Sub
</td></tr></table><button onclick='document.all("1219200620240765").value=document.all("1219200620240765").value.replace(/ \s\s/g,"");document.all("1219200620240765").value=document.all("1219200620240765").value.replace(/ /g,"");window.clipboardData.setData("Text",document.all("1219200620240765").value);'>Copy to Clipboard</BUTTON><textarea style="position:absolute;visibility:hidden" name="1219200620240765" wrap="virtual">
Option Explicit

Dim WithEvents u As MSForms.UserForm
Dim WithEvents t As MSForms.textbox
Dim WithEvents ob As MSForms.OptionButton
Dim WithEvents lb As MSForms.ListBox
Dim WithEvents dp As MSComCtl2.DTPicker

Event KeyDown(ByVal KeyCode As Integer, ByVal Shift As Integer)
'Event KeyPress(ByVal KeyAscii As Integer)

Private FireOnThisKeyCode As Integer

Friend Sub AddToPreview(Parent As UserForm, KeyCode As Integer)
Dim c As Control
Set u = Parent
FireOnThisKeyCode = KeyCode
For Each c In Parent.Controls
Select Case TypeName(c)
Case "TextBox"
Set t = c
Case "OptionButton"
Set ob = c
Case "ListBox"
Set lb = c
Case "DTPicker"
Set dp = c
End Select
Next c
End Sub

Private Sub u_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = FireOnThisKeyCode Then RaiseEvent KeyDown(KeyCode, Shift)
End Sub

Private Sub t_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = FireOnThisKeyCode Then RaiseEvent KeyDown(KeyCode, Shift)
End Sub

Private Sub ob_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = FireOnThisKeyCode Then RaiseEvent KeyDown(KeyCode, Shift)
End Sub

Private Sub lb_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = FireOnThisKeyCode Then RaiseEvent KeyDown(KeyCode, Shift)
End Sub

Private Sub dp_KeyDown(KeyCode As Integer, ByVal Shift As Integer)
If KeyCode = FireOnThisKeyCode Then RaiseEvent KeyDown(KeyCode, Shift)
End Sub</textarea>

VBAKeyPreview.zip

ktab · Dec 20, 2006

Thank you for your example book and suggestions.
Even if not now, surely I'm gonna use it in the future.
Works great. Thanx again

Pirate · Jul 19, 2012

Hi Tom

I'm having trouble adapting your code to work with a userform that contains multiple instances of each control. It seems it is not possible to define a control withapps as an array.
do you know of any workaround for this?

Tom Schreiner said:
Here is a very simple example. In the real world, I would create a separate type for each type of control abd allow you to pass an array or filter. You only need to deal with controls that can recieve the focus. Controls such as the label do not have a keydown event because they cannot accept the focus. The toolbar can actually recieve the focus but it is rare. Usually you have to set the focus to this control via code.

VBAKeyPreview.zip

Userform1 with:
TextBox1
OptionButton1
ListBox1
DTPicker1
Label1
ToolBar1

This code in the uf:

**Option Explicit

**Dim WithEvents kp As KeyPreview

**Private Sub UserForm_Initialize()
****** Set kp = New KeyPreview
****** kp.AddToPreview Me, 114
**End Sub

**Private Sub kp_KeyDown(ByVal KeyCode As Integer, ByVal Shift As Integer)
****** MsgBox "F3 was pressed..."
**End Sub

<TBODY>
</TBODY>
<BUTTON *******='document.all("1219200620233343").value=document.all("1219200620233343").value.replace(/
\s\s/g,"");document.all("1219200620233343").value=document.all("1219200620233343").value.replace(/
/g,"");window.clipboardData.setData("Text",document.all("1219200620233343").value);'>Copy to Clipboard</BUTTON><TEXTAREA style="VISIBILITY: hidden; POSITION: absolute" name=1219200620233343 wrap=virtual> Option Explicit Dim WithEvents kp As KeyPreview Private Sub UserForm_Initialize() Set kp = New KeyPreview kp.AddToPreview Me, 114 End Sub Private Sub kp_KeyDown(ByVal KeyCode As Integer, ByVal Shift As Integer) MsgBox "F3 was pressed..." End Sub</TEXTAREA>

This code in a class module named "KeyPreview":

**Option Explicit

**Dim WithEvents u As MSForms.UserForm
**Dim WithEvents t As MSForms.textbox
**Dim WithEvents ob As MSForms.OptionButton
**Dim WithEvents lb As MSForms.ListBox
**Dim WithEvents dp As MSComCtl2.DTPicker

**Event KeyDown(ByVal KeyCode As Integer, ByVal Shift As Integer)
**'Event KeyPress(ByVal KeyAscii As Integer)

**Private FireOnThisKeyCode As Integer

**Friend Sub AddToPreview(Parent As UserForm, KeyCode As Integer)
****** Dim c As Control
****** Set u = Parent
****** FireOnThisKeyCode = KeyCode
****** For Each c In Parent.Controls
********** Select Case TypeName(c)
************** Case "TextBox"
****************** Set t = c
************** Case "OptionButton"
****************** Set ob = c
************** Case "ListBox"
****************** Set lb = c
************** Case "DTPicker"
****************** Set dp = c
********** End Select
****** Next c
**End Sub

**Private Sub u_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
****** If KeyCode = FireOnThisKeyCode Then RaiseEvent KeyDown(KeyCode, Shift)
**End Sub

**Private Sub t_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
****** If KeyCode = FireOnThisKeyCode Then RaiseEvent KeyDown(KeyCode, Shift)
**End Sub

**Private Sub ob_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
****** If KeyCode = FireOnThisKeyCode Then RaiseEvent KeyDown(KeyCode, Shift)
**End Sub

**Private Sub lb_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
****** If KeyCode = FireOnThisKeyCode Then RaiseEvent KeyDown(KeyCode, Shift)
**End Sub

**Private Sub dp_KeyDown(KeyCode As Integer, ByVal Shift As Integer)
****** If KeyCode = FireOnThisKeyCode Then RaiseEvent KeyDown(KeyCode, Shift)
**End Sub

<TBODY>
</TBODY>
<BUTTON *******='document.all("1219200620240765").value=document.all("1219200620240765").value.replace(/
\s\s/g,"");document.all("1219200620240765").value=document.all("1219200620240765").value.replace(/
/g,"");window.clipboardData.setData("Text",document.all("1219200620240765").value);'>Copy to Clipboard</BUTTON><TEXTAREA style="VISIBILITY: hidden; POSITION: absolute" name=1219200620240765 wrap=virtual> Option Explicit Dim WithEvents u As MSForms.UserForm Dim WithEvents t As MSForms.textbox Dim WithEvents ob As MSForms.OptionButton Dim WithEvents lb As MSForms.ListBox Dim WithEvents dp As MSComCtl2.DTPicker Event KeyDown(ByVal KeyCode As Integer, ByVal Shift As Integer) 'Event KeyPress(ByVal KeyAscii As Integer) Private FireOnThisKeyCode As Integer Friend Sub AddToPreview(Parent As UserForm, KeyCode As Integer) Dim c As Control Set u = Parent FireOnThisKeyCode = KeyCode For Each c In Parent.Controls Select Case TypeName(c) Case "TextBox" Set t = c Case "OptionButton" Set ob = c Case "ListBox" Set lb = c Case "DTPicker" Set dp = c End Select Next c End Sub Private Sub u_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) If KeyCode = FireOnThisKeyCode Then RaiseEvent KeyDown(KeyCode, Shift) End Sub Private Sub t_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) If KeyCode = FireOnThisKeyCode Then RaiseEvent KeyDown(KeyCode, Shift) End Sub Private Sub ob_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) If KeyCode = FireOnThisKeyCode Then RaiseEvent KeyDown(KeyCode, Shift) End Sub Private Sub lb_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) If KeyCode = FireOnThisKeyCode Then RaiseEvent KeyDown(KeyCode, Shift) End Sub Private Sub dp_KeyDown(KeyCode As Integer, ByVal Shift As Integer) If KeyCode = FireOnThisKeyCode Then RaiseEvent KeyDown(KeyCode, Shift) End Sub</TEXTAREA>

VBAKeyPreview.zip

application.onkey using userform

ktab

Well-known Member

Excel Facts

Legacy 98055

Guest

ktab

Well-known Member

Legacy 98055

Guest

ktab

Well-known Member

Legacy 98055

Guest

ktab

Well-known Member

Pirate

New Member

Similar threads

Forum statistics

Share this page

application.onkey using userform

ktab

Well-known Member

Excel Facts

Legacy 98055

Guest

ktab

Well-known Member

Legacy 98055

Guest

ktab

Well-known Member

Legacy 98055

Guest

ktab

Well-known Member

Pirate

New Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock