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
Related
What I'm trying to get working:
activate the Text Highlight Color command via a keybinding (not the problem)
cycle through 5 of the Default Text Highlight Colors via the same keybinding (or just highlighting the selection, depending on selection.type checked outside the function below)
showing the current Color in the corresponding button (built-in ribbon)
Where I'm stuck:
Sub cycleThroughSomeDefaultHighlightColorIndexOptions()
Dim zeNewColor As Long
Select Case Options.DefaultHighlightColorIndex
Case wdYellow: zeNewColor = wdBrightGreen
Case wdBrightGreen: zeNewColor = wdTurquoise
Case wdTurquoise: zeNewColor = wdPink
Case wdBlue: zeNewColor = wdRed
Case wdRed: zeNewColor = wdYellow
Case Else: zeNewColor = wdYellow
End Select
Application.Options.DefaultHighlightColorIndex = zeNewColor
End Sub
doesn't throw any error, does change the Application.Options.DefaultHighlightColorIndex,
but doesn't update/show the newly set color on the corresponding (built-in ribbon home tab) button
and just exits out of the Text Highlight Color mode.
Is there a possibility to keep it going?
If it needs to be started again: is there a better way than
dirty/interfering sendKeys to call commands like Text Highlight
Color?
Update 2019-04-03:
In the mean time i found where the IRibbonUI.InvalidateControlMso ControlIDs are listed: Office 2016 Help Files: Office Fluent User Interface Control Identifiers
So after creating a hidden custom ribbon and getting a handle for it on onLoad i could zeWdRibbon.InvalidateControlMso "TextHighlightColorPicker" without any raised error.
But it also doesn't change anything.
Is it possible, that Microsoft just getImages the default imageMso "TextHighlightColorPicker" (yellow) without checking for Application.Options.DefaultHighlightColorIndex , or am I missing something?
I do something like that, each time gRibbon.Invalidate
#If VBA7 Then
Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
#Else
Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
#End If
Public gRibbon As IRibbonUI
#If VBA7 Then
Function GetRibbon(ByVal lRibbonPointer As LongPtr) As Object
#Else
Function GetRibbon(ByVal lRibbonPointer As Long) As Object
#End If
Dim objRibbon As Object
Call CopyMemory(objRibbon, lRibbonPointer, LenB(lRibbonPointer))
Set GetRibbon = objRibbon
Set objRibbon = Nothing
End Function
Public Sub OnRibbonLoad(ribbon As IRibbonUI)
Set gRibbon = ribbon
'SAVE SETTINGS TO REGISTRY
SaveSetting "POP", "RIBBON", "ribbonPointer", ObjPtr(gRibbon)
End Sub
Public Sub OnActionButton(control As IRibbonControl)
If gRibbon Is Nothing Then
Set gRibbon = GetRibbon(GetSetting("POP", "RIBBON", "ribbonPointer"))
End If
On Error Resume Next
gRibbon.Invalidate
On Error GoTo 0
End Sub
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.
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
I have some workbooks, which starts with automatic macros and data refreshing (and, pre-empting some suggestions, these workbooks need to work like that, because I'm starting them automatically from Windows scheduler and I need them to perform tasks without any action on the user's part).
When I need to check/update some formulas, SQL query or layout, I just open a workbook holding [Shift] key and it prevents triggering macros in Workbook_Open / Auto_Open events etc., which is great.
The problem is that there are still some external data sources which are automatically refreshed during the opening. In some of these workbooks queries take a long while to accomplish and I need to wait a minute or two before I can edit a workbook.
Is there any way I could open a workbook with both macros and data refreshing disabled? Or, perhaps, any simple way to cancel executing a query?
Go Into the Excel Options
navigate to Trust Center then Trust Center Settings and go to
External Content.
You'll see the Security Settings for Data Connections and Workbook Links. Disable both.
Restart Excel and you're done.
In Office 2010, go to the same External Content menu, and select Disable all Data Connections as well as Disable automatic update of workbook links.
After inserting the code into the proper modules run CreateAltStartVBS. CreateAltStartVBS will create a VBScript file (AltStart.vbs) in the workbooks folder. When you run AltStart.vbs it will start your workbook bypassing your opening macros and disabling the Connections from refreshing.
Workbook Module
Private Sub Workbook_BeforeClose(Cancel As Boolean)
EnableRefresh True
End Sub
Private Sub Workbook_Open()
If getSwitch = "/z" Then
EnableRefresh False
Exit Sub
End Sub
'Normal code goes here
End Sub
Sub EnableRefresh(Enable As Boolean)
Dim conn As Object
For Each conn In ActiveWorkbook.Connections
conn.ODBCConnection.EnableRefresh = Enable
Next
End Sub
Standard Module
Option Base 0
Option Explicit
Declare Function GetCommandLine Lib "kernel32" Alias "GetCommandLineW" () As Long
Declare Function lstrlenW Lib "kernel32" (ByVal lpString As Long) As Long
Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (MyDest As Any, MySource As Any, ByVal MySize As Long)
Function CmdToSTr(Cmd As Long) As String
Dim Buffer() As Byte
Dim StrLen As Long
If Cmd Then
StrLen = lstrlenW(Cmd) * 2
If StrLen Then
ReDim Buffer(0 To (StrLen - 1)) As Byte
CopyMemory Buffer(0), ByVal Cmd, StrLen
CmdToSTr = Buffer
End If
End If
End Function
Function getSwitch()
Dim CmdRaw As Long
Dim CmdLine As String
CmdRaw = GetCommandLine
CmdLine = CmdToSTr(CmdRaw)
getSwitch = Split(CmdLine, Chr(34))(2)
End Function
Sub EnableConnections(Enable As Boolean)
Dim conn As Object
For Each conn In ActiveWorkbook.Connections
conn.ODBCConnection.EnableRefresh = Enable
Next
End Sub
Sub CreateAltStartVBS()
Dim myFile As String
myFile = ThisWorkbook.Path & "\AltStart.vbs"
Open myFile For Output As #1
Print #1, "Dim objShell"
Print #1, "Set objShell = CreateObject (""WScript.Shell"")"
Print #1, "objShell.Run ""excel.exe /z """ & Chr(34) & ThisWorkbook.FullName & Chr(34)
Print #1, "Set objShell = Nothing"
Close #1
End Sub
I'd like to create a button that automatically opens a hyperlink from Powerpoint.
It's easy enough to create a hyperlink in Powerpoint (Insert -> Hyperlink) and then click on that hyperlink.
I want to skip this whole process and just be able to have a button that opens a hyperlink rather than having a hyperlink in my presentation that needs to be clicked.
The XML for the button would be something like:
<button id="myButton" label="Open Hyperlink"
imageMso="HyperlinkInsert"
size="large"
onAction="openHyperlink"
/>
Of course you will need to modify the file's Ribbon XML; the above is not a complete ribbon, just the node for the desired button. I have some other Q&A about modifying the ribbon here otherwise there are some great examples if you google for them. Most are for Word or Excel, but the same principles apply. If you need references, let me know and I can provide a few.
And the callback would be like:
Sub openHyperlink(control As IRibbonControl)
'your code that opens the hyperlink goes in here, something like:
Dim ie as Object
Set ie = CreateObject("InternetExplorer.Application")
ie.Visible = True
ie.Navigate "http://google.com"
End Sub
To open a PDF instead of a browser, change that procedure:
Sub openHyperlink(control As IRibbonControl)
Dim acroPath As String
Dim filePath As String
acroPath = "C:\Program Files (x86)\Adobe\Reader 10.0\Reader\AcroRd32.exe" 'Modify as needed
filePath = "c:\users\me\file.pdf" 'Modify as needed
Shell acroPath & " " & filePath, vbNormalFocus
End Sub
You can use the ShellExecute API to open any document in the default app for that document's extension. Here's a simplified hack to start with:
Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
(ByVal hwnd As Long, ByVal lpszOp As String, _
ByVal lpszFile As String, ByVal lpszParams As String, _
ByVal LpszDir As String, ByVal FsShowCmd As Long) _
As Long
Function ShellEx(sFile As String) As Long
ShellEx = ShellExecute(&O0, "Open", sFile, "", "C:\", 1)
End Function
Sub Test()
Debug.Print ShellEx("path to file goes here")
End Sub
More detailed version with all the options here:
http://support.microsoft.com/kb/170918