I want to do a Makro with VBA which measures the amount of time the user presses a key, for example Space.
And when the user stops pressing it, the Time is stored and added to the time when the key is pressed again.
Im new to VBA and have some problems with the syntax. So I found the keyUP and keyDown functions here, but it seems that im using it the wrong way.
My code so far:
Sub KeyTime()
Time_old = 0
Range("A1").Value = Time_old
If Form_KeyDown(vbKeySpace, 0) Then
Start_time = Timer
If Form_KeyUp(vbKeySpace, 0) Then
End_time = Timer
Time = End_time - Start_time + Time_old
Time_old = Time
Range("A1").Value = Time_old
End If
End If
End Sub
The Userform's Key Events will not fire if a control has focus. You'll need either use a global variable or a Static method to track the key press.
Here I use a Static array variable inside a sub routine the track all the standard key presses.
Sub CountKeyPresses(KeyAscii As MSForms.ReturnInteger)
Static KeyCounts(255) As Long
If KeyAscii <= 255 Then
KeyCounts(KeyAscii) = KeyCounts(KeyAscii) + 1
Me.Caption = "Key(" & Chr(KeyAscii) & ") was pressed " & KeyCounts(KeyAscii) & " times"
End If
End Sub
Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
CountKeyPresses KeyAscii
End Sub
Private Sub TextBox2_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
CountKeyPresses KeyAscii
End Sub
Related
I am trying to check if a user enters a number value in a textbox, decimal places accepted. Any help is highly appreciated.
Private Sub textbox1_AfterUpdate()
If IsNumeric(textbox1.Value) = False Then
Me!textbox1.Undo
MsgBox "only numbers are allowed"
Exit Sub
End If
Exit Sub
using BeforeUpdate event:
Private Sub textbox1_BeforeUpdate(Cancel As Integer)
If IsNumeric(textbox1.Value) = False Then
MsgBox "only numbers are allowed"
Me!textbox1.Undo
Cancel = True
Exit Sub
End If
Exit Sub
My current code does not execute at all. I have also tried it in the textbox1_BeforeUpdate event. Please see code.
New Code:
Public Function IsValidKeyAscii(ByVal keyAscii As Integer, ByVal value As
String) As Boolean
IsValidKeyAscii = (keyAscii = vbKeyDot And InStr(1, value, Chr$(vbKeyDot)) =
0) Or (keyAscii >= vbKey0 And keyAscii <= vbKey9)
End Function
Private Sub textbox1_KeyDown(KeyCode As Integer, Shift As Integer)
If Not IsValidKeyAscii(KeyCode, textbox1.value) Then KeyCode = 0
End Sub
You shouldn't be using VBA for this task at all.
Just set the field format property to General number. That's the built-in way to ensure users can only enter numbers in a field.
Write a validator function (could be in its own KeyInputValidator class or module), so you can reuse this logic everywhere you need it, instead of copy/pasting it for every numeric textbox you need:
Option Explicit
Private Const vbKeyDot As Integer = 46
'#Description("returns true if specified keyAscii is a number, or if it's a dot and value doesn't already contain one")
Public Function IsValidKeyAscii(ByVal keyAscii As Integer, ByVal value As String) As Boolean
IsValidKeyAscii = (keyAscii = vbKeyDot And InStr(1, value, Chr$(vbKeyDot)) = 0) Or (keyAscii >= vbKey0 And keyAscii <= vbKey9)
End Function
Then use it in the textboxes' KeyPress event handler (assuming this is a MSForms textbox control) to determine whether or not to accept the input - since the event provides a MSForms.ReturnInteger object, that object's Value property can be set to 0 to "swallow" a keypress:
Private Sub TextBox1_KeyPress(ByVal keyAscii As MSForms.ReturnInteger)
If Not IsValidKeyAscii(keyAscii.Value, TextBox1.value) Then keyAscii.Value = 0
End Sub
That way you don't need to undo any inputs, or pop any annoying warning or message boxes: the value in the field is guaranteed to be a valid numeric value!
EDIT the above event handler signature is for a MSForms control. Looks like Access uses a different interface:
Private Sub TextBox1_KeyDown(KeyCode As Integer, Shift As Integer)
Here the KeyCode is passed ByRef, so you can alter it directly. In other words, this becomes the logic:
If Not IsValidKeyAscii(KeyCode, TextBox1.value) Then KeyCode = 0
You can try using the lost focus event:
Private Sub TextBox1_LostFocus()
Dim blnNumber As Boolean
Dim strNumber As String
strNumber = TextBox1.Value
blnNumber = IsNumeric(strNumber)
If Not blnNumber Then
Me!TextBox1.Undo
MsgBox "only numbers are allowed"
Else
'And, if you want to force a decimal.
If InStr(strNumber, ".") < 1 Then
Me!TextBox1.Undo
MsgBox "only doubles are allowed"
End If
End If
End Sub
Also, check the Textbox1 element that you have listed in access. Is it's name TextBox1? or something else?
For example, in excel it is represented like the following: =EMBED("Forms.TextBox.1","") even though the name that the code references is TextBox1.
I have a form with a TextBox1 and a CommandButton1.
The Cancel property of the CommandButton1 is True. So I can close the form with a key press on Esc.
The TextBox1 has an Exit event, so when leaving this element will fire an event. In this event I will print the user input and some static content.
Sub CommandButton1_Click()
Unload Me
End Sub
Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Debug.Print "Textbox1_Exit was fired, content was: " & TextBox1.Value
End Sub
Now I enter some content in the TextBox1, let's say I enter 'foo'.
If I close the form with the CommandButton1 the output will be:
TextBox1_Exit was fired, content was: foo
The problem:
If I leave the form via the Esc key, the output will only be:
TextBox1_Exit was fired, content was:
So only the static part of Debug.Print will be printed.
I would like to get the user input in both cases.
Okay so this was a bit tricky - since you can't grab the TextBox1.Value when using Esc from the Userform, you can use a Public string variable instead which mimics the entries made into the TextBox. So you'll need to declare a Public variable, add a TextBox_Change event, and add a Userform_Initialize event to reset the string each time:
Public mystring As String
Sub CommandButton1_Click()
Unload Me
End Sub
Private Sub TextBox1_Change()
If Not Len(TextBox1.Value) <= Len(mystring) + 1 Then
mystring = mystring & Right(TextBox1.Value, 1)
Else
If TextBox1.Value <> "" Then
mystring = TextBox1.Value
End If
End If
End Sub
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Debug.Print "Textbox_Exit was fired, content was: " & mystring
End Sub
Private Sub UserForm_Initialize()
mystring = ""
End Sub
you could use UserForm_QueryClose event to catch the UserForm exit event and call TextBox1_Exit one:
Option Explicit
Sub CommandButton1_Click()
Unload Me
End Sub
Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Debug.Print "Textbox1_Exit was fired, content was: " & TextBox1.Value
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Dim myVar As MSForms.ReturnBoolean
Me.TextBox1_Exit myVar
End Sub
I have the following form in excel. It is part of a simple inventory worksheet, and is used to update the status of items. It was functioning as intended, however when I tried to add in a checkbox to make the selected status persist (allowing me to only type in the serial rather than serial and status every time when working with a batch of items) I noticed that the focus after submitting cycles forward as if I pressed tab rather than being where I set it with SetFocus.
I'm presuming this is an oversight related to either the event cycle for KeyDown or nested If/Else logic, but I've had no luck actually diagnosing it. I've only recently started using VBA, and there are a lot of quirks I'm trying to understand.
Private Sub clear()
Me.txtSerial = ""
If cbPersist.Object.Value = False Then
Me.cboxStatus = ""
Me.cboxStatus.SetFocus
Else
Me.txtSerial.SetFocus
End If
End Sub
Private Sub submit()
Dim loc As Range
Dim ws As Worksheet
Set ws = Worksheets("Full Inventory")
Set loc = ws.Columns("B").Find(what:=Me.txtSerial.Value, LookIn:=xlValues, lookat:=xlWhole)
If Not loc Is Nothing Then
ActiveWindow.ScrollRow = loc.Row
ws.Cells(loc.Row, 10).Value = Me.cboxStatus.Value
Else
MsgBox "Serial not found."
End If
clear
End Sub
Private Sub txtSerial_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = vbKeyReturn Then
submit
ElseIf KeyCode = vbKeyEscape Then
clear
End If
End Sub
Private Sub UserForm_Initialize()
cboxStatus.List = Array("Stock", "Shipped", "Research", "Sent Back", "Return")
End Sub
Suggest the following:
Code snippet of UserForm module
Private Sub txtSerial_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = vbKeyReturn Then
submit
KeyCode = vbKeyPageDown ' << modify Enter key value to prevent from tab hopping
ElseIf KeyCode = vbKeyEscape Then
clear
End If
End Sub
I have a User-form
For most of Check-Boxes/ Buttons I assigned a Key. Can be execute by pressing:
Alt + Assigned-key
I had googled the following code.
Private Sub UserForm_Initialize()
Me.PASTE.Accelerator = "V"
Me.CEEMEA.Accelerator = "C"
End Sub
Problem is I have to Press Alt key to perform any given task.
Q. Is there any short way of doing this without pressing AltKey?
My progress After Robin's Original-Answer
Firstly I set focus on Macros Button.
Private Sub UserForm_Initialize()
Me.Macros.SetFocus
End Sub
Then on Macro_Keydown Event I put the following code.
Private Sub Macros_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = vbKeyB Then
Bulgaria.Value = Not Bulgaria.Value
ElseIf KeyCode = vbKeyE Then
Estonia.Value = Not Estonia.Value
ElseIf KeyCode = vbKeyH Then
Hungary.Value = Not Hungary.Value
ElseIf KeyCode = vbKeyA Then
Latvia.Value = Not Latvia.Value
ElseIf KeyCode = vbKeyL Then
Lithuania.Value = Not Lithuania.Value
ElseIf KeyCode = vbKeyM Then
Macedonia.Value = Not Macedonia.Value
ElseIf KeyCode = vbKeyP Then
Poland.Value = Not Poland.Value
ElseIf KeyCode = vbKeyR Then
Romania.Value = Not Romania.Value
ElseIf KeyCode = vbKeyU Then
Ukraine.Value = Not Ukraine.Value
End If
End Sub
Updated answer
The original answer didn't really meet the brief because whilst handling the UserForm events for e.g. KeyDown works for a form with no other controls, it doesn't work for a form with controls. This is because the event only works when the form has the focus. When the form has other controls, it never receives the focus. Also, it is not possible to set the focus onto the UserForm. Almost all forms will have some other controls, so the original answer is practically useless. So let's shamelessly adapt an idea from Andy Pope on MSDN to meet the OP's requirements.
First, insert a VBA Class into the project with this code:
Public WithEvents m_objGroupCheckBox As MSForms.CheckBox
Private Sub m_objGroupCheckBox_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
MsgBox "Keypress was: " & Chr(KeyCode) & " on " & m_objGroupCheckBox.Caption
Select Case Chr(KeyCode)
Case 1:
UserForm1.CheckBox1.Value = Not UserForm1.CheckBox1.Value
Case 2:
UserForm1.CheckBox2.Value = Not UserForm1.CheckBox2.Value
Case "3"
UserForm1.CheckBox3.Value = Not UserForm1.CheckBox3.Value
End Select
End Sub
The Class defines a generic event handler for a CheckBox on the UserForm. For the purposes of this example, we will make key presses of 1, 2 and 3 toggle the checkbox state for the 3 CheckBoxs on the form.
Second, put the code in the Userform's initialize event. It creates a collection of this custom class that references back to the original checkboxes created on the UserForm.
Private m_colCheckBoxes As Collection
Private Sub UserForm_Initialize()
Dim lngIndex As Long
Dim objGroupCheckBox As clsGroupCheckBox
Set m_colCheckBoxes = New Collection
For lngIndex = 1 To 3
Set objGroupCheckBox = New clsGroupCheckBox
Set objGroupCheckBox.m_objGroupCheckBox = Me.Controls("CheckBox" & lngIndex)
m_colCheckBoxes.Add objGroupCheckBox, CStr(m_colCheckBoxes.Count + 1)
Next
End Sub
So now, if we have a UserForm in the designer like this, with each CheckBox named CheckBox1, CheckBox2 and CheckBox3:
Then, our generic event handler will allow us to define a single place to handle the KeyDown event and set CheckBox status in one spot.
Original answer - not as useful as it looks :(
You can directly handle the KeyDown event of the UserForm and enter your specific logic in there. Maybe you should check out KeyUp and KeyPress as well depending on how you think the form will work.
MSDN notes that '..."A" and "a" are returned as the same key. They have the identical keycode value. But note that "1" on the typewriter keys and "1" on the numeric keypad are returned as different keys, even though they generate the same character.' - MSDN Link
You can handle SHIFT, CTRL and ALT as well.
Private Sub UserForm_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode >= vbKeyA And KeyCode <= vbKeyZ Then
MsgBox "You pressed " & Chr(KeyCode)
ElseIf KeyCode >= vbKeyF1 And KeyCode <= vbKeyF12 Then
MsgBox "Function time!"
End If
End Sub
'VBA Shortcut Keys not work in UserForm [Partially Solved]
Public Sub CallSub() 'code must be in Module
'-do this code-
Private Sub Workbook_Activate() 'code must be in (ThisWorkbook)
Application.OnKey "^{f5}", "callSub"
'^ this code only work with Excel Worksheet not in Userform
Private Sub XxX_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) 'code must be in Userform with SHOWMODAL = False
If KeyCode = 17 Then AppActivate "microsoft excel"
'XxX means all CommandButton and Textbox and Listbox and Combobox
'Keycode 17 is Ctrl Key if you are using Ctrl+F5 - when you press Ctrl it will activate Excel Worksheet
I am dealing with data input. Every time before I input one record, I need to search and locate one cell in about 5000 rows. I am thinking if it is possible to do the search while typing instead of using the search function in excel. My idea is to capture the keypress event of a spreadsheet, if it is a character (letter 'A' to 'Z' or 'a' to 'z'), append it to a string called searchVal do the search immediate with a function. When the user press ESC, it will clean up the searchVal. First of all, I got the following code from online, trying to capture the ESC keydown
Private searchVal As String
Private Sub Workbook_Activate()
Application.OnKey "ESC", "CleanSearchKey"
End Sub
Private Sub Workbook_Deactivate()
Application.OnKey "ESC"
End Sub
Sub CleanSearchKey()
searchVal = ""
MsgBox "CleanSearchKey"
End Sub
But his code doesn't work, it seems that the CleanSearchKey never triggered. As for capturing the key down for 'A' to 'Z' and 'a' to 'z', I don't want know how to capture it in a sheet so I add an inputbox on sheet1, assigned the following macro to the inputbox
Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If (KeyAscii >= 65 And KeyAscii <= 90) Or (KeyAscii >= 97 And KeyAscii <= 122) Then
searchVal = searchVal & KeyAscii
Else
KeyAscii = 0
End If
End Sub
But it then said "Compile error: User-defined type not defined". So what is the right way to capture the key on a sheet? Thanks.
The code you added for a TextBox is only applicable to a TextBox which appears on a UserForm object. I don't think text boxes on worksheets respond to events like KeyPress.
That said, you could easily configure a simple userform to do this.
I modified your code a little bit. I think this should get you started. In a normal code module, do a procedure like this which will launch the UserForm. This will allow you to show the form from the Macros ribbon menu. Otherwise, you will have to invoke it manually from the Immediate Window or by pressing F5 in the VBE.
Sub ShowForm()
UserForm1.Show vbModeless
End Sub
Create a UserForm, and add a textbox. Its default name should be TextBox1, if it is not, then make sure to change it. In the userForm's code module, do this:
Option Explicit
Dim searchVal As String
Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
searchVal = TextBox1.Value
If (KeyAscii >= 65 And KeyAscii <= 90) Or (KeyAscii >= 97 And KeyAscii <= 122) Then
searchVal = searchVal & Chr(KeyAscii)
TextBox1.Value = searchVal
Call FindValue
End If
If KeyAscii = 27 Then 'ESC
searchVal = vbNullString
TextBox1.Value = vbNullString
Else:
KeyAscii = 0
End If
End Sub
Sub FindValue()
Dim rngFound as Range
With ActiveSheet
set rngFound = .Cells.Find(searchVal)
End With
If rngFound Is Nothing Then
MsgBox searchVal & " not found!"
Else
MsgBox searchVal & " found at " & rngFound.Address
End If
End Sub