Getting an application_calculate event to run - vba

We have an AddIn to get data from Sun Financials. It uses Sendkeys so we get the problem of NumLock randomly turning off.
Data is retrieved from Sun when the worksheet/book is recalculated.
I have VBA to turn NumLock back on if it's turned off, but how can I get it to run in any workbook I have open?
I tried putting an Application_Calculate in Personal.xlsb ThisWorkbook but it doesn't run.
How can I get it to run?
Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Private Sub Application_Calculate(ByVal Sh As Object)
If CBool(GetKeyState(vbKeyNumlock) And 1) = False Then SendKeys "{NUMLOCK}", True
End Sub
PS Putting it into the ThisWorkbook outside of personal.xlsb isn't an option, there's thousands of files it needs to work on plus they don't like workbooks with VBA in (company policy).

Got this working, by placing the following code into ThisWorkbook in Personal.xlsb
Bizarre. or not. It now works, but it's not worked until everything was correct. Here's what I've got:-
Code:
Option Explicit
Public WithEvents App As Application
Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Private Sub App_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Set App = Application
If CBool(GetKeyState(vbKeyNumlock) And 1) = False Then SendKeys "{NUMLOCK}", True
End Sub
Private Sub Workbook_Open()
Set App = Application
End Sub
Private Sub App_SheetCalculate(ByVal Sh As Object)
Set App = Application
End Sub
So, when I hit F9 or change a cell, NumLock turns back on.
One stightly bizarre but useful feature is that the Undo list is preserved! I was expecting to have to restore it once I'd got the Numlock bit working, but as the VBA is only doing a Sendkey and not flagging anything as changing from within the VBA Excel miraculously isn't emptying the Undo or Redo list. So the maxim that VBA always empties the Undo/Redo lists isn't true.

Related

Minimize the Word once you opened the Document

In Excel-VBA, you can minimize the Excel Application once you opened the Workbook:
Private Sub Workbook_Open()
Application.WindowState = xlMinimized
End Sub
In Word-VBA, I tried this code, but it didn't work:
Private Sub Document_Open()
Application.WindowState = wdWindowStateMinimize
End Sub
It should be minimize the Word Application once you opened the Document.
Ok, after some testing I got it running, but it's a bit strange. It seems to be a timing problem.
This works:
Using DoEvents two times always works in my tests.
Only one DoEvents is not enough.
Info from Microsofts documentation about DoEvents:
Yields execution so that the operating system can process other events.
Private Sub Document_Open()
DoEvents: DoEvents
Application.WindowState = wdWindowStateMinimize
End Sub
That doesn't work either:
So I thought about adding a delay by using the API procedure Sleep and call this and DoEvents in a loop. But it didn't work.
Private Declare PtrSafe Sub Sleep Lib "Kernel32" (ByVal dwMilliseconds As LongPtr)
Private Sub Document_Open()
Dim index As Integer
For index = 1 To 5
DoEvents
Sleep 50
Next index
Application.WindowState = wdWindowStateMinimize
End Sub
Contrary to the Excel documentation, the Word documentation of the Application.WindowState property says that the windows state can only be set with an active window:
The state of an inactive window cannot be set. Use the Activate method to activate a window prior to setting the window state.
So maybe you try to call Application.Activate first and see if that helps.
Contrary to the Excel documentation, the Word documentation of the
Application.WindowState property says that the windows state can only
be set with an active window:
Unhandled Exception gave a best description about the Application.WindowState.
Private Sub Document_Open()
ActiveWindow.WindowState = wdWindowStateMinimize
End Sub

VBA Editor flashes during Macro run

after a lot of research I couldn't find anyone with the same problem as me. So can any of the gurus please help me with my Excel Macro?
My macro does the following:
Open another excel workbook
Copy over the first sheet from this workbook to my current workbook
Create a button in the copied sheet
Write some code in this new created button
And here is the problem, when my macro writes the code in the button, it opens the VBA Code Editor and closes afterwards. My macro does it many times, so the VBA Code Editor keeps flashing during the macro run.
"Application.ScreenUpdating = False" didn't resolve the issue.
Please see below my code to do this Step 4 and let me know if you know a solution for that.
wb is my Workbook and ws my Worksheet
Set oOleObj = ws.OLEObjects.Add(ClassType:="Forms.CommandButton.1", Link:=False, DisplayAsIcon:=False, Left:=5.4, Top:=4.8, Width:=97.2, Height:=35.4)
Set VBP = wb.VBProject
Set VBC = VBP.VBComponents(VBP.VBComponents.Count)
Set CM = VBC.CodeModule
With wb.VBProject.VBComponents(wb.Worksheets(ws.Name).CodeName).CodeModule
LineNum = .CreateEventProc("click", oOleObj.Name)
LineNum = LineNum + 1
.InsertLines LineNum, "UploadToAlmButton_OnClick"
End With
I could simple protect the project from viewing with a password. That should resolve the issue, but creates another one: If it's protected, I cannot write code on it by macro as I am doing in the Step 4. :(
Thanks!
To hide VBE window
Application.VBE.MainWindow.Visible = False
Application.VBE.MainWindow.Visible = True
If VBE window is still flickering then you need to use LockWindowUpdate Windows API function.
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal ClassName As String, ByVal WindowName As String) As Long
Private Declare Function LockWindowUpdate Lib "user32" _
(ByVal hWndLock As Long) As Long
Sub EliminateScreenFlicker()
Dim VBEHwnd As Long
On Error GoTo ErrH:
Application.VBE.MainWindow.Visible = False
VBEHwnd = FindWindow("wndclass_desked_gsk", _
Application.VBE.MainWindow.Caption)
If VBEHwnd Then
LockWindowUpdate VBEHwnd
End If
'''''''''''''''''''''''''
' your code here
'''''''''''''''''''''''''
Application.VBE.MainWindow.Visible = False
ErrH:
LockWindowUpdate 0&
End Sub
References:
Cpearson - Eliminating Screen Flicker During VBProject Code
MSDN- VBE flashes while programming in the VBE

Programmatically dismiss a MsgBox

I have a master macro in an Excel file, 'file A' that opens another Excel file, 'file B'. On open, an add-in imports data into 'file B'. I would like to close 'file B' once the add-in is finished importing, and I'm looking for the best way to do that.
I've written the code to open 'file B' (which triggers the add-in automatically) and to close the file, but when the add-in is finished, it opens a MsgBox to notify the user. I'm trying to completely automate an internal process, so dismissing the MsgBox programmatically would be ideal.
Is it possible to dismiss a MsgBox through VBA? I'm aware that I can create timed MsgBoxes in VBA but I'm not creating this MsgBox (the add-in is); I just want to dismiss it. I'm open to creating a Word file and calling a macro from that if required, but would prefer not to use SendKeys.
Since the "add-in" and Excel/VBA run in the same context, we cannot launch it and monitor its message-box within the same VBA application, because each VBA application is a single-threaded process. Fortunately however, there is a solution that can exploit the fact that different VBA applications run in different contexts, so they can run in parallel.
My suggested solution is to create a MS-Word document that is dedicated to monitoring and closing that message box. We need this in Word (or any other office application) in order to make the monitoring code and the addin's code run in parallel, in different contexts.
1- create a Word macro-enable document, named mboxKiller.docm and place it in some folder; i.e. C:\SO in my example. place this code in ThisDocument and save:
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Sub WaitAndKillWindow()
On Error Resume Next
Dim h As Long: h = FindWindow(vbNullString, "Microsoft Excel")
If h <> 0 Then SendMessage h, 16, 0, 0 ' <-- WM_Close
Application.OnTime Now + TimeSerial(0, 0, 1), "WaitAndKillWindow"
End Sub
Private Sub Document_Open()
WaitAndKillWindow
End Sub
2- In the Excel workbook's VBA, create a class module, named mboxKiller with this code:
Private killerDoc As Object
Private Sub Class_Initialize()
On Error Resume Next
Set killerDoc = CreateObject("Word.Application").Documents.Open(Filename:="C:\SO\mboxKiller.docm", ReadOnly:=True)
If Err.Number <> 0 Then
If Not killerDoc Is Nothing Then killerDoc.Close False
Set killerDoc = Nothing
MsgBox "could not lauch The mboxKiller killer. The message-box shall be closed manuallt by the user."
End If
End Sub
Private Sub Class_Terminate()
On Error Resume Next
If Not killerDoc Is Nothing Then killerDoc.Application.Quit False
End Sub
3- Testing and Usage. In a normal class Module, place the following code and test the procedure
Sub Test() ' <-- run this for testing after finishing the setup
Dim killer: Set killer = New mboxKiller
simulateAddin
simulateAddin
simulateAddin
End Sub
' Procedure supposed to do some calculation then display a message box
Private Sub simulateAddin()
Dim i As Long
For i = 0 To 1000: DoEvents: Next ' simulates some calculations
MsgBox "This is a message box to simulate the message box of the addin." & VbCrLf & _
"It will be automatically closed by the Word app mboxKiller"
End Sub
VBA also has the ability to temporarily dismiss alerts.
Application.DisplayAlerts = False
'while you run your code here, no alerts will be displayed
Application.DisplayAlerts = True

Create Formula in a TextBox using Excel VBA

Does anyone know if it's possible to have a textbox in a userform in Excel 2010 work like the formula editor?
In other words when the userform is up and the textbox is the focused control allow me to type say
=AND(
Then click cell D2 and have the text box then be
=AND($D$2
Then type a =
=AND($D$2=
Then click cell E2
=AND($D$2=$E$2
Then type )
=AND($D$2=$E$2)
I've played around with the RefEdit control but it just overwrites any custom text as soon as a range is selected on the sheet, I basically need it to append to the text box when I click on a range.
Put this code in the ThisWorkbook module:
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
On Error GoTo EndOfSub
If UserForm1.ActiveControl.Name = "TextBox1" Then
UserForm1.TextBox1.Value = UserForm1.TextBox1.Value & Target.Address
End If
EndOfSub:
End Sub
This way when your userform is loaded (UserForm1 here) and your textbox is active (TextBox1 here), the address of the selection is appended to it. If you need to add the worksheet's name too, change the 3rd line above:
UserForm1.TextBox1.Value = UserForm1.TextBox1.Value & sh.Name & "!" & Target.Address
If you need to use it on only one sheet, put the code to that Sheet's code instead of the ThisWorkbook's code.
It is not as sophisticated as the formula editor, as it always appends the selection. (Changing the just inserted reference is doable too if you need it, just takes a bit more checking.)
Do note that putting code into the ThisWorkbook's SheetChange method takes its toll: you will not be able to use Undo in this workbook.
A bit more elegant way to check if a Userform is loaded can be found (here)[http://www.ozgrid.com/forum/showthread.php?t=152892]. You can use this instead of the On Error Goto part.
Yes, this is possible in a TextBox, but the problem you have is that you'll need to show the UserForm modelessly because you need to select cells in a worksheet while the Userform is on show. If you want to do exactly as you describe, ie the very next keystroke is '=', then you will need to re-activate the UserForm otherwise you'll simply add an '=' into your selected cell.
I believe the Show command won't re-activate a modeless UserForm that is already on show and I'm not aware of an Activate command for a UserForm. Others may well know of one, but I'd use a couple of APIs to do the job. So the code in your Userform could be as follows (you may need to adjust the API declarations if you have Win64 and/or VB7 https://msdn.microsoft.com/en-us/library/office/ee691831(v=office.14).aspx):
Option Explicit
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetFocusAPI Lib "user32" Alias "SetForegroundWindow" _
(ByVal hwnd As Long) As Long
Private mHwnd As Long
Private mTextBoxHasFocus As Boolean
Public Property Get TextBoxHasFocus()
TextBoxHasFocus = mTextBoxHasFocus
End Property
Public Sub AppendText(appendedText As String)
'Add the text to textbox
TextBox1.Text = TextBox1.Text & appendedText
'Activate this userform window
SetFocusAPI mHwnd
'API doesn't trigger UserForm_Activate event so call it
Me.ActivateByCode
End Sub
Private Sub TextBox1_Enter()
mTextBoxHasFocus = True
End Sub
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
mTextBoxHasFocus = False
End Sub
Public Sub ActivateByCode()
'Set focus on any another control then back to textbox
btnSave.SetFocus
'Set cursor at end of text
TextBox1.SelStart = Len(TextBox1.Text)
TextBox1.SelLength = 0
TextBox1.SetFocus
End Sub
Private Sub UserForm_Initialize()
'Acquire the handle for this window
mHwnd = FindWindow("ThunderDFrame", Me.Caption)
End Sub
You'd then call the AppendText routine from a WorkSheet_Change event or, as in this case, a Workbook_SheetSelectionChange event (which caters for selections of a cell in any WorkSheet):
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If UserForm1.TextBoxHasFocus Then
UserForm1.AppendText Target.Address
'Uncomment the line below if you want sheet name as well as address
'UserForm1.AppendText Sh.Name & "!" & Target.Address
End If
End Sub
And remember to show your UserForm modelessly:
UserForm1.Show False
If you want to cursor to be in the TextBox when the UserForm opens, then add this line too:
UserForm1.ActivateByCode
(Posted on behalf of the question author).
Checking for the selection changed was what I was missing. I was SO focused on trying to make the UserForm behave I completely spaced on ALL the other events Excel has to work with!
In the end I went with a check in the SelectionChanged sub to see if a simpler UserForm (minimal size with textbox and restore button) was visible and the textbox was active.
I added a little more logic to handle inserting into the cursor location of the textbox as well as straight appending. Might add some support for arrow keys in the future but I have the original functionality I set out to have.
Microsoft, if you're listening, would it have been possible to give us a RefEdit control that looks and behaves like the one built into Excel? Just a thought.

SendKeys is messing with my NumLock key via VBA code in Access form

I have the following code for an Access form. It appears as if the SendKeys is messing with my NumLock key by toggling it on and off as I open and close the form.
For perfectly valid reasons which I don't want to get into, I really do not want to completely hide the ribbon (I want the pull down menus still accessible) so the DoCmd.ShowToolbar command is not my preferred way of doing it.
Does anyone have any suggestions as to how I can modify the code below to accomplish what I want using the SendKeys command?
Using Access 2007 so the command
CommandBars.ExecuteMso "MinimizeRibbon"
is not available to me.
By the way, database will be distributed so solution must be contained within database.
Private Sub Form_Close()
' Unhide navigation pane
DoCmd.NavigateTo "acNavigationCategoryObjectType"
DoCmd.Maximize
' Maximize the ribbon
RibbonState = (CommandBars("Ribbon").Controls(1).Height < 75)
Select Case RibbonState
Case True
SendKeys "^{F1}", True
Case False
'Do nothing, already maximized
End Select
End Sub
Private Sub Form_Load()
' Hide navigation pane
DoCmd.NavigateTo "acNavigationCategoryObjectType"
DoCmd.Minimize
Debug.Print Application.CommandBars.Item("Ribbon").Height
' Minimize ribbon
RibbonState = (CommandBars("Ribbon").Controls(1).Height < 100)
Select Case RibbonState
Case True
'Do nothing, already minimized
Case False
SendKeys "^{F1}", False
End Select
End Sub
It's a bug in Microsoft VBA. But there is a workaround.
Use F8 to run through the macro and find where it turns it off. It's usually after a SendKeys.
Then add an
Sendkeys "{NUMLOCK}", True after the line to reverse the effect.
If you can't find it, just add it at the end and when it finishes, it will go back. Hopefully, if you add it during the show/hide process, it will work.
This is caused by :
Sendkeys "any key", False
Instead of False as second parameter, use True.
I had similar issue and I found solution on some vba forum. Instead of buggy Sendkeys you can simulate kyes like this.
Option Explicit
'//WIN32API Declare
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
'//WIN32API Constant
Public Const KEYEVENTF_EXTENDEDKEY = &H1
Public Const KEYEVENTF_KEYUP = &H2
Public Const VK_CONTROL = &H11
Public Const VK_SHIFT = &H10
Public Const VK_F6 = &H75
Public Function PreviousTab()
keybd_event VK_CONTROL, 0, 0, 0
keybd_event VK_SHIFT, 0, 0, 0
keybd_event VK_F6, 0, 0, 0
keybd_event VK_F6, 0, KEYEVENTF_KEYUP, 0
keybd_event VK_SHIFT, 0, KEYEVENTF_KEYUP, 0
keybd_event VK_CONTROL, 0, KEYEVENTF_KEYUP, 0
End Function
Other keys can be found here vba forum
This "previousTab" function just send Control+Shift+F6 key.
The SendKeys() function that is built-in VBA has really a side effect that causes NumLock to be deactivated. But you can use a workaround and call another implementation of the same function that is a part of WSCRIPT component (a part of Windows operating system). The following sample code shows, how a reference to this component can be made and then its method called:
Set WshShell = CreateObject("WScript.Shell")
WshShell.SendKeys "^g", True
This way, you get the same functionality (calling Ctrl-G keyboard shortcut in the example), but there is no issue with NumLock in this case.
When you do a final sendKeys command in your code, adding in {NUMLOCK} to the statement may do the trick, as noted by RodB and iceBird76. But this is not a good coding practice, and here is why: if anything is different from one time to the next when you run the macro, it may or may not work. I know this because I was experiencing a similar issue myself. When I would do a sendKeys command at the end of my program, sometimes the Num Lock would stay on, but other times it would stay off, just depending on certain variables in my spreadsheet (regardless of whether or not I included {NUMLOCK} in my last SendKeys statement).
I won't get into the details of my own variables, but the point is that to build a program/macro that will keep your Num Lock on consistently, you need to FIRST TEST TO SEE IF THE NUM LOCK IS ON OR OFF, then execute code based upon the present condition.
Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Private Const kNumlock = 144
Public Function NumLock() As Boolean
NumLock = KeyState(kNumlock)
If (NumLock = True) Then
MsgBox ("Num lock was off. Will turn back on now...")
SendKeys "{NUMLOCK}", True
Else: MsgBox ("Num Lock stayed on")
End If
End Function
Private Function KeyState(lKey As Long) As Boolean
KeyState = CBool(GetKeyState(lKey))
End Function
Sub myMainMethod()
'do a function here that includes .SendKeys
Call NumLock
End Sub
This sample program will give you a confirmation message as to whether the Num Lock is on or off, and turn it on if it is off.
Right after your SendKeys statement add these 2 lines:
DoEvents
SendKeys "{NUMLOCK}{NUMLOCK}"
This line caused my problem:
Application.SendKeys "%s"
SOLVED by changing to this:
Application.SendKeys "{NUMLOCK}%s"
There's no difference between adding {NUMLOCK} at the beginning or end of the string.
in my case application.senkeys method was creating this problem. so I used
with shell
.sendkeys "{}"
End with
Instead of
with shell
Application.sendkeys ("{}")
End with
64bit VBA version
Private Declare PtrSafe Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Private Const VK_NUMLOCK = &H90
If GetKeyState(VK_NUMLOCK) = 0 Then
SendKeys "{NUMLOCK}", True
End If
You could also check the return value from GetKeyState() before using SendKeys() and restore it by either executing SendKeys "{NUMLOCK}" or not when finished.
SendKeys "^{HOME}", True was turning off the num lock so I just repeated the command and it turns it back on again:
SendKeys "^{HOME}", True
SendKeys "^{HOME}", True
After trying many solutions. The most solid seems to be on the link below. Paste it to a Module.
http://access.mvps.org/access/api/api0046.htm