Public Function EnterToTab(KeyAscii As Integer)
If KeyAscii = vbKeyReturn Then
SendKeys "{tab}"
KeyAscii = 0
End If
End Function
Private Sub txtUserCode_KeyPress(KeyAscii As Integer)
Call EnterToTab(KeyAscii)
End Sub
This code belongs to log-in form.
The txtUserCode contains code of specific user stored in database.
While running this form, when I enter any number in txtUserCode and press enter it doesn't go to next text box, it's keyascii became 49 which is not equal to 13.
The same thing is happening by pressing tab.
What about switching to the next text field using the setFocus method instead of simulating a TAB?
Private Sub txtUserCode_KeyPress(KeyAscii As Integer)
If (KeyAscii = vbKeyReturn) Then
txtNextTextField.setFocus
End If
End Sub
You could also use a controls array (array of all text fields contained in your form) and increment the index. So you could use this code for all text fields of your form without having to write redundant code.
So if the user presses return in text field index 0, you set the focus to index+1 (=1). To create a controls array, copy your first text field and paste it to the form. VB6 will ask you whether you want to create a controls array. If you click "yes", it will do automatically. Then you can use the following code:
Private Sub txtField_KeyPress(Index As Integer, KeyAscii As Integer)
If (KeyAscii = vbKeyReturn) Then
If ((Index + 1) < txtField.Count) Then
txtField(Index+1).setFocus
Else
MsgBox "Reached end of form!"
End If
End If
End Sub
There is a KB142816 How To Make ENTER Key Move Focus Like TAB Key for VB Controls with a reference implementation similar to yours. But. It's most important part, IMO, is disclaimer:
You can cause the ENTER key to move the focus to the control with the
next higher TabIndex property value, as the TAB key does.
However, using the ENTER key to move the focus does not follow
recommended Microsoft Windows-based application design guidelines. The
ENTER key should be used to process the default command or to process
entered information, not to move the focus.
Anyway, the reason your code doesn't work is a mystery. As neither Tab nor Enter moves focus from txtUserCode field, my only guess is that txtUserCode is the only field with TabStop property set to True. I.e. there's simply no other control to move focus to.
The example MrSnurb gives is a good start, but it's has a lot of problems, for instance, a control could be disabled or not visible (setfocus will crash), the next control in your controlarray doesn't mean it's also the next control which would get focus when using tab (you can set the tabindex whatever you want).
I've conjured 2 'simple' routines (and an extra function) which you can use to go to next or previous controls on a form (haven't actually checked if it works with a control on a container (Frame or something)), so it might need extra checks for that..
'##############################################################################
'##
'## Function fnControlCanHaveFocus
'##
'##############################################################################
'A separate routine, because On Error goto doesn't work with this type of
'error in the IDE within a For Each loop,
'even if you have set 'Only break on unhandled' errors
Private Function fnControlCanHaveFocus(ByRef ctrl As Control) As Boolean
On Error GoTo ErrorHandling
'--------------------------------------------------------------
'Check for properties which lets a control get a focus
'For now also Check TabStop even though the control CAN have focus if this is off
fnControlCanHaveFocus = (ctrl.TabStop And _
ctrl.Enabled And _
ctrl.Visible)
Exit Function
ErrorHandling:
fnControlCanHaveFocus = False
End Function
'##############################################################################
'##
'## Sub pSetFocusToNextControl
'##
'##############################################################################
Private Sub pSetFocusToNextControl(ByRef frm As Form)
Dim ctrl As Control
Dim ctrlFirst As Control
Dim ctrlNext As Control
'--------------------------------------------------------------
'Is there even an active control?
If Not frm.ActiveControl Is Nothing Then
'--------------------------------------------------------------
'Try and find the First and next control which can receive focus
Set ctrlFirst = Nothing
Set ctrlNext = Nothing
For Each ctrl In frm.Controls
'--------------------------------------------------------------
'Can this control have focus?
If fnControlCanHaveFocus(ctrl) And _
Not ctrl Is frm.ActiveControl Then
'--------------------------------------------------------------
'Check for Next control
If ctrl.TabIndex > frm.ActiveControl.TabIndex Then
If ctrlNext Is Nothing Then
Set ctrlNext = ctrl
ElseIf ctrlNext.TabIndex > ctrl.TabIndex Then
Set ctrlNext = ctrl
End If 'ElseIf ctrlNext.TabIndex>ctrl.TabIndex
End If 'If ctrl.TabIndex>frm.ActiveControl.TabIndex
'--------------------------------------------------------------
'Check for first control
If ctrlFirst Is Nothing Then
Set ctrlFirst = ctrl
ElseIf ctrlFirst.TabIndex < ctrl.TabIndex Then
Set ctrlFirst = ctrl
End If 'ElseIf ctrlFirst.TabIndex<ctrl.TabIndex
End If 'If fnControlCanHaveFocus(ctrl) And...
Next ctrl
'--------------------------------------------------------------
'Is there a next control to set focus to?
If Not ctrlNext Is Nothing Then
Call ctrlNext.SetFocus
'--------------------------------------------------------------
'No next control, but a first control to jump to?
ElseIf Not ctrlFirst Is Nothing Then
Call ctrlFirst.SetFocus
End If 'ElseIf Not ctrlFirst Is Nothing
End If 'If Not frm.ActiveControl Is Nothing
End Sub
'##############################################################################
'##
'## Sub pSetFocusToPreviousControl
'##
'##############################################################################
Private Sub pSetFocusToPreviousControl(ByRef frm As Form)
Dim ctrl As Control
Dim ctrlLast As Control
Dim ctrlPrevious As Control
'--------------------------------------------------------------
'Is there even an active control?
If Not frm.ActiveControl Is Nothing Then
'--------------------------------------------------------------
'Try and find the Last and previous control which can receive focus
Set ctrlLast = Nothing
Set ctrlPrevious = Nothing
For Each ctrl In frm.Controls
'--------------------------------------------------------------
'Can this control have focus?
If fnControlCanHaveFocus(ctrl) And _
Not ctrl Is frm.ActiveControl Then
'--------------------------------------------------------------
'Check for Previous control
If ctrl.TabIndex < frm.ActiveControl.TabIndex Then
If ctrlPrevious Is Nothing Then
Set ctrlPrevious = ctrl
ElseIf ctrlPrevious.TabIndex < ctrl.TabIndex Then
Set ctrlPrevious = ctrl
End If 'ElseIf ctrlPrevious.TabIndex<ctrl.TabIndex
End If 'If ctrl.TabIndex<frm.ActiveControl.TabIndex
'--------------------------------------------------------------
'Check for Last control
If ctrlLast Is Nothing Then
Set ctrlLast = ctrl
ElseIf ctrlLast.TabIndex > ctrl.TabIndex Then
Set ctrlLast = ctrl
End If 'ElseIf ctrlLast.TabIndex>ctrl.TabIndex
End If 'If fnControlCanHaveFocus(ctrl) And...
Next ctrl
'--------------------------------------------------------------
'Is there a previous control to set focus to?
If Not ctrlPrevious Is Nothing Then
Call ctrlPrevious.SetFocus
'--------------------------------------------------------------
'No previous control but a Last control to jump to?
ElseIf Not ctrlLast Is Nothing Then
Call ctrlLast.SetFocus
End If 'ElseIf Not ctrlLast Is Nothing
End If 'If Not frm.ActiveControl Is Nothing
End Sub
And you use it like this for instance:
Private Sub txt_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
Select Case KeyCode
Case vbKeyDown, _
vbKeyReturn
Call pSetFocusToNextControl(Me)
KeyCode = 0
Case vbKeyUp
Call pSetFocusToPreviousControl(Me)
KeyCode = 0
End Select
End Sub
Related
im writing a code in vbscript where it will ask the user for input and then run certain files according to the input and i have the else so that it will redo the if else sequence when you type something that isnt an option but when i try to press cancel or the red 'X' it acts as if i have put in an invalid input and goes over the else sequence.
Dim sInput
sInput = InputBox("input")
If sInput = "input1" or sInput = "input2" Then
set shell=createobject("wscript.shell")
shell.run "file.bat"
elseif sInput = "exit" or sInput = "Exit" Then
WScript.Quit
else
name=msgbox (" That is not a valid response",0+16,"ERROR")
set shell=createobject("wscript.shell")
shell.run "input.vbs"
end if
Don't try to restart the script.
Use a loop instead. End the loop when the user entered a valid option, or quit the entire program if requested.
Option Explicit
Dim Shell, input, button
Set Shell = CreateObject("WScript.Shell")
Do
input = InputBox("input")
If IsEmpty(input) Or LCase(input) = "exit" Then WScript.Quit
input = LCase(Trim(input))
If input = "input1" Or input = "input2" Then
Shell.Run "file.bat"
Exit Do
Else
button = MsgBox("That is not a valid response.", vbExclamation + vbRetryCancel, "ERROR")
If button = vbCancel Then Exit Do
End If
Loop
Notes:
Option Explicit makes variable declaration mandatory. It's a good idea to always have this enabled.
IsEmpty() is true when the user pressed the Cancel button (or the Esc key) in the InputBox - but this will work only before the response is manipulated in any way, such as LCase or Trim. Supporting the Cancel button is more intuitive than having a special "exit" keyword, so maybe you should get rid of that.
The various constants you can use with MsgBox are described on ss64.com and in more detal in the official VBScript language reference.
You can change what Enter and Esc do in each MsgBox by using the vbDefaultButton1 or vbDefaultButton2 constants.
The Do loop without any conditions (Do/Loop While ... or Do/Loop Until ...) will run forever - be sure not to forget using Exit Do or WScript.Quit(). (If you do, killing the Script with the Task Manager will get you out of it.)
Hi I would like to ask if it's possible to map the KeyDown for keyboards in Visual Basic 6 to turn the state of a graphical Command Button on the form to the "Down State" while keyboard key is pressed then back to raised when released? Thanks
I am aware of the problem here, because I did somewhat similar in the past and ended up by using an array of PictureBoxes instead of graphical CommandButtons.
Anyway, a simple workaround with CommandButtons is to keep the focus away by adding to the Form another control which can act as focus target. Remember: when a Form goes activated, it will place the focus to the first focusable control inside itself.
As You haven't specified in Your question what kind of keyboard state You need, below is a simple example with the a s d f keys. You will need less than 5 minutes to get it up and running.
Step 0:
Copy and paste following declarations to Your VB Form:
Option Explicit
Option Base 0
Const BM_SETSTATE = &HF3
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim Target(254) As Long
Step 1:
Add to Your Form an array of CommandButtons called, for instance, Button(0), Button(1), Button(2), Button(3) and so on.
Set the properties which You need (Picture, DownPicture, etc.) and set also:
TabStop: False
Double-click one of this CommandButtons. You can see, You have just one entry point for the whole array of Controls. Choose GotFocus from the event drop-down and put this piece of code:
Private Sub Button_GotFocus(Index As Integer)
PicFocus.SetFocus
End Sub
Step 2:
On Your VB Form, set this property:
KeyPreview: True
Double-click the Form, choose Load from the event drop-down and set Your desired mapping between a KeyCode and the corresponding CommandButton:
Private Sub Form_Load()
Target(65) = Button(0).hwnd ' 65: KeyCode for "a"
Target(83) = Button(1).hwnd ' 83: KeyCode for "s"
Target(68) = Button(2).hwnd ' 68: KeyCode for "d"
Target(70) = Button(3).hwnd ' 70: KeyCode for "f"
End Sub
Choose KeyDown and KeyUp from the event drop-down and put inside the two global keyboard event handlers this piece of code - respectively -1 for the down-state and 0 for the up-state:
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
' Debug.Print KeyCode
Call PostMessage(Target(KeyCode), BM_SETSTATE, -1&, 0&)
End Sub
Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
Call PostMessage(Target(KeyCode), BM_SETSTATE, 0&, 0&)
End Sub
Step 3:
Lastly, add to the same VB Form the PictureBox mentioned above and set following properties:
Name: PicFocus
Appearance: 0-Flat
BorderStyle: 0-None
HasDC: False
TabIndex: 0
TabStop: False
Width: 255
Left: -1000
Press Ctrl+F5 and test if this is what You need.
The CommandButton control has mouse and keyboard down and up events:
Private Sub Command1_Click()
Debug.Print "click"
End Sub
Private Sub Command1_KeyDown(KeyCode As Integer, Shift As Integer)
Debug.Print "keydown"
End Sub
Private Sub Command1_KeyUp(KeyCode As Integer, Shift As Integer)
Debug.Print "keyup"
End Sub
Private Sub Command1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Debug.Print "mousedown"
End Sub
Private Sub Command1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Debug.Print "mouseup"
End Sub
I want to write a simple Excel macro, that invokes Add Digital Signature dialog for the user. I do not want to add the signature itself, just to show the Add Digital Signature dialog so that user doesn't have to look for it him or herself. I was googling for solution and understand that this can not be done in native Excel VBA. One has to call Windows Shell directly. How do I do that?
You don't state your Excel version but assuming you have a version with the ribbon UI. There are a couple of options - you can use the fluent UI control identifier and this code:
Option Explicit
Sub FindControlByFluentUIId()
Dim objCtrl As CommandBarControl
Dim lngId As Long
On Error GoTo ErrHandler
' magic number of Add Digital Signature
lngId = 13035
' find that control in the command bars collection
' this line throws an error for some workbooks !?
Set obj = Application.CommandBars.FindControl(Office.MsoControlType.msoControlButton, lngId)
' execute
If Not obj Is Nothing Then
obj.Execute
Else
MsgBox "Not found"
End If
End Sub
ErrHandler:
If Err.Number <> 0 Then
Debug.Print Err.Description
End If
End Sub
The full list of codes is here: https://www.microsoft.com/en-us/download/details.aspx?id=36798
If you didn't know the ID for some reason you can manually search each control collection of each command bar for a control with Caption this is like the one you are looking for. You are better off doing a wildcard search with the Like operator because you may not know the exact case of the control caption and position of the &s that facilitate keyboard short-cuts.
You can try something like this:
Option Explicit
Sub TestFindControl()
Dim strCaptionWild As String
Dim objCtrl As CommandBarControl
' use wildcards to help find the control
strCaptionWild = "*add*a*digital*signature*"
' call the function to find by caption
Set objCtrl = FindControl(strCaptionWild)
' execute on match
If Not objCtrl Is Nothing Then
Debug.Print "Command bar index: " & objCtrl.Parent.Index
Debug.Print "Control index: " & objCtrl.Index
Debug.Print "Real caption: " & objCtrl.Caption
objCtrl.Execute
Else
MsgBox "Not found for caption: " & strCaptionWild
End If
End Sub
Function FindControl(ByVal strCaption As String) As CommandBarControl
Dim objCb As CommandBar
Dim objCtrl As CommandBarControl
Dim blnFound As Boolean
On Error GoTo ErrHandler
' not found the control
blnFound = False
' iterate command bars and their controls
For Each objCb In Application.CommandBars
For Each objCtrl In objCb.Controls
' use like operator check control caption vs input caption
' LIKE enables use of wildcard matching
If LCase$(objCtrl.Caption) Like LCase$(strCaption) Then
' found it
blnFound = True
Exit For
End If
Next objCtrl
If blnFound Then Exit For
Next objCb
Set FindControl = objCtrl
Exit Function
ErrHandler:
Debug.Print Err.Description
Set FindControl = Nothing
End Function
I need a macro to show a msgbox whenever an invalid value is posted. I need that cell to only accept values in this format "LLXXXXXXX" where L is letter and X is number. I'm using Data validation to show an error message. Any ideas?
As everyone has stated, use data validation.
Here is a macro, however.
Change [A1] to the cell you want to monitor.
Put this in the worksheet object of the sheet with the cell you want to monitor.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [A1]) Is Nothing Then
If Not [A1] Like "[A-z][A-z]#######" Then
[A1].Select
MsgBox ("Invalid value in A1!")
End If
End If
End Sub
Edit: Just because, here is a solution for multiple cells.
This will also display one messagebox that lists the incorrect cells.
It will also color the cells red if they are incorrect.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim MonRange As Range
'What range do we want to monitor?
Set MonRange = [A1:A10]
'---------------------------------
If Not Intersect(Target, MonRange) Is Nothing Then
Dim c As Range, Inc As String
Inc = "Incorrect Cells: " & Chr(13) & "-----------------" & Chr(13)
For Each c In Intersect(Target, MonRange)
If Not c Like "[A-z][A-z]#######" Then
Inc = Inc & c.Address(False,False) & ","
c.Interior.Color = RGB(230, 180, 180)
Else
c.Interior.ColorIndex = xlNone
End If
Next c
If Len(Inc) <> 36 Then MsgBox (Left(Inc,Len(Inc)-1))
End If
End Sub
How can i restrict an event to occur? Suppose i don't want textbox change event to occur when i press backspace.
Setting KeyAscii=0 in the KeyPress event will cause the keypress to be ignored.
Private Sub myTextBox_KeyPress(KeyAscii As Integer)
If KeyAscii = vbKeyBack Then KeyAscii = 0
End Sub
Since the Change event doesn't pass you the code of the last key pressed, you'll have to store that in the KeyPress event, then you can immediately exit the Change event whenever the backspace key is pressed.
Private keyCode As Integer
Private Sub Text1_Change()
If (keyCode = vbKeyBack) Then
Exit Sub
Else
// do whatever it is you want to do in this event
// P.S.: I know this is the wrong comment syntax,
// but this code prettifier has a problem with
// VB6 comments
End If
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
keyCode = KeyAscii
End Sub