application.onkey using userform

ktab

Well-known Member
Joined
Apr 21, 2005
Messages
1,297
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
 

Some videos you may like

Excel Facts

Last used cell?
Press Ctrl+End to move to what Excel thinks is the last used cell.
L

Legacy 98055

Guest
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.
 
L

Legacy 98055

Guest
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

Well-known Member
Joined
Apr 21, 2005
Messages
1,297

ADVERTISEMENT

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 ;)
 
L

Legacy 98055

Guest
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:progid:DXImageTransform.Microsoft.Gradient(endColorstr='#C0CFE2', startColorstr='#FFFFFF', gradientType='0');"><tr><TD><font size="2" face=Courier New>  <font color="#0000A0">Option</font> <font color="#0000A0">Explicit</font>

  <font color="#0000A0">Dim</font> <font color="#0000A0">WithEvents</font> kp <font color="#0000A0">As</font> KeyPreview

  <font color="#0000A0">Private</font> <font color="#0000A0">Sub</font> UserForm_Initialize()
       <font color="#0000A0">Set</font> kp = <font color="#0000A0">New</font> KeyPreview
       kp.AddToPreview Me, 114
  <font color="#0000A0">End</font> <font color="#0000A0">Sub</font>

  <font color="#0000A0">Private</font> <font color="#0000A0">Sub</font> kp_KeyDown(ByVal KeyCode <font color="#0000A0">As</font> Integer, <font color="#0000A0">ByVal</font> Shift <font color="#0000A0">As</font> Integer)
       MsgBox "F3 was pressed..."
  <font color="#0000A0">End</font> <font color="#0000A0">Sub</font>
</FONT></td></tr></table><button onclick='document.all("1219200620233343").value=document.all("1219200620233343").value.replace(/<br \/>\s\s/g,"");document.all("1219200620233343").value=document.all("1219200620233343").value.replace(/<br \/>/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:progid:DXImageTransform.Microsoft.Gradient(endColorstr='#C0CFE2', startColorstr='#FFFFFF', gradientType='0');"><tr><TD><font size="2" face=Courier New>  <font color="#0000A0">Option</font> <font color="#0000A0">Explicit</font>

  <font color="#0000A0">Dim</font> <font color="#0000A0">WithEvents</font> u <font color="#0000A0">As</font> MSForms.UserForm
  <font color="#0000A0">Dim</font> <font color="#0000A0">WithEvents</font> t <font color="#0000A0">As</font> MSForms.textbox
  <font color="#0000A0">Dim</font> <font color="#0000A0">WithEvents</font> ob <font color="#0000A0">As</font> MSForms.OptionButton
  <font color="#0000A0">Dim</font> <font color="#0000A0">WithEvents</font> lb <font color="#0000A0">As</font> MSForms.ListBox
  <font color="#0000A0">Dim</font> <font color="#0000A0">WithEvents</font> dp <font color="#0000A0">As</font> MSComCtl2.DTPicker

  <font color="#0000A0">Event</font> KeyDown(ByVal KeyCode <font color="#0000A0">As</font> Integer, <font color="#0000A0">ByVal</font> Shift <font color="#0000A0">As</font> Integer)
  <font color="#008000">'Event KeyPress(ByVal KeyAscii As Integer)</font>

  <font color="#0000A0">Private</font> FireOnThisKeyCode <font color="#0000A0">As</font> <font color="#0000A0">Integer</font>

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

  <font color="#0000A0">Private</font> <font color="#0000A0">Sub</font> u_KeyDown(ByVal KeyCode <font color="#0000A0">As</font> MSForms.ReturnInteger, <font color="#0000A0">ByVal</font> Shift <font color="#0000A0">As</font> Integer)
       <font color="#0000A0">If</font> KeyCode = FireOnThisKeyCode <font color="#0000A0">Then</font> <font color="#0000A0">RaiseEvent</font> KeyDown(KeyCode, Shift)
  <font color="#0000A0">End</font> <font color="#0000A0">Sub</font>

  <font color="#0000A0">Private</font> <font color="#0000A0">Sub</font> t_KeyDown(ByVal KeyCode <font color="#0000A0">As</font> MSForms.ReturnInteger, <font color="#0000A0">ByVal</font> Shift <font color="#0000A0">As</font> Integer)
       <font color="#0000A0">If</font> KeyCode = FireOnThisKeyCode <font color="#0000A0">Then</font> <font color="#0000A0">RaiseEvent</font> KeyDown(KeyCode, Shift)
  <font color="#0000A0">End</font> <font color="#0000A0">Sub</font>

  <font color="#0000A0">Private</font> <font color="#0000A0">Sub</font> ob_KeyDown(ByVal KeyCode <font color="#0000A0">As</font> MSForms.ReturnInteger, <font color="#0000A0">ByVal</font> Shift <font color="#0000A0">As</font> Integer)
       <font color="#0000A0">If</font> KeyCode = FireOnThisKeyCode <font color="#0000A0">Then</font> <font color="#0000A0">RaiseEvent</font> KeyDown(KeyCode, Shift)
  <font color="#0000A0">End</font> <font color="#0000A0">Sub</font>

  <font color="#0000A0">Private</font> <font color="#0000A0">Sub</font> lb_KeyDown(ByVal KeyCode <font color="#0000A0">As</font> MSForms.ReturnInteger, <font color="#0000A0">ByVal</font> Shift <font color="#0000A0">As</font> Integer)
       <font color="#0000A0">If</font> KeyCode = FireOnThisKeyCode <font color="#0000A0">Then</font> <font color="#0000A0">RaiseEvent</font> KeyDown(KeyCode, Shift)
  <font color="#0000A0">End</font> <font color="#0000A0">Sub</font>

  <font color="#0000A0">Private</font> <font color="#0000A0">Sub</font> dp_KeyDown(KeyCode <font color="#0000A0">As</font> Integer, <font color="#0000A0">ByVal</font> Shift <font color="#0000A0">As</font> Integer)
       <font color="#0000A0">If</font> KeyCode = FireOnThisKeyCode <font color="#0000A0">Then</font> <font color="#0000A0">RaiseEvent</font> KeyDown(KeyCode, Shift)
  <font color="#0000A0">End</font> <font color="#0000A0">Sub</font>
</FONT></td></tr></table><button onclick='document.all("1219200620240765").value=document.all("1219200620240765").value.replace(/<br \/>\s\s/g,"");document.all("1219200620240765").value=document.all("1219200620240765").value.replace(/<br \/>/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

Well-known Member
Joined
Apr 21, 2005
Messages
1,297
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

New Member
Joined
Jul 24, 2008
Messages
2
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?




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><br />Option Explicit<br /> <br />Dim WithEvents kp As KeyPreview<br /><br />Private Sub UserForm_Initialize()<br /> Set kp = New KeyPreview<br /> kp.AddToPreview Me, 114<br />End Sub<br /><br />Private Sub kp_KeyDown(ByVal KeyCode As Integer, ByVal Shift As Integer)<br /> MsgBox "F3 was pressed..."<br />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><br />Option Explicit<br /><br />Dim WithEvents u As MSForms.UserForm<br />Dim WithEvents t As MSForms.textbox<br />Dim WithEvents ob As MSForms.OptionButton<br />Dim WithEvents lb As MSForms.ListBox<br />Dim WithEvents dp As MSComCtl2.DTPicker<br /><br />Event KeyDown(ByVal KeyCode As Integer, ByVal Shift As Integer)<br />'Event KeyPress(ByVal KeyAscii As Integer)<br /><br />Private FireOnThisKeyCode As Integer<br /><br />Friend Sub AddToPreview(Parent As UserForm, KeyCode As Integer)<br /> Dim c As Control<br /> Set u = Parent<br /> FireOnThisKeyCode = KeyCode<br /> For Each c In Parent.Controls<br /> Select Case TypeName(c)<br /> Case "TextBox"<br /> Set t = c<br /> Case "OptionButton"<br /> Set ob = c<br /> Case "ListBox"<br /> Set lb = c<br /> Case "DTPicker"<br /> Set dp = c<br /> End Select<br /> Next c<br />End Sub<br /><br />Private Sub u_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)<br /> If KeyCode = FireOnThisKeyCode Then RaiseEvent KeyDown(KeyCode, Shift)<br />End Sub<br /><br />Private Sub t_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)<br /> If KeyCode = FireOnThisKeyCode Then RaiseEvent KeyDown(KeyCode, Shift)<br />End Sub<br /><br />Private Sub ob_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)<br /> If KeyCode = FireOnThisKeyCode Then RaiseEvent KeyDown(KeyCode, Shift)<br />End Sub<br /><br />Private Sub lb_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)<br /> If KeyCode = FireOnThisKeyCode Then RaiseEvent KeyDown(KeyCode, Shift)<br />End Sub<br /><br />Private Sub dp_KeyDown(KeyCode As Integer, ByVal Shift As Integer)<br /> If KeyCode = FireOnThisKeyCode Then RaiseEvent KeyDown(KeyCode, Shift)<br />End Sub</TEXTAREA>

VBAKeyPreview.zip
 

Watch MrExcel Video

Forum statistics

Threads
1,109,181
Messages
5,527,278
Members
409,756
Latest member
punknwilly

This Week's Hot Topics

Top