article

VBA-macros as

Email
Submitted on: 1/19/2015 6:15:00 PM
By: Norbert Schafer (from psc cd)  
Level: Intermediate
User Rating: By 3 Users
Compatibility: VBA MS Excel
Views: 741
 
     If you want to make your VBA macro "look and feel" like a real VB-Application or if you want to learn more about advanced VBA programming, this tutorial might be of interest to you.

This article has accompanying files
 
				VBA is a nice tool for quick-and-dirty macro programming.
However, it lacks quite a few things to enable the programmer
to build "full-fledged" applications using VBA.
This is a pity as it's more common to have a customer's PC
with MS-Office installed than a PC with VB on it.
I tried to overcome some of these limitations as there are:
-"cosmetics"
-windows show up always at the same position
-no Minimize button in window caption
By the way, substitute "Excel" by "Word" if you're
using the Word-VBA.
Cosmetics
---------
The first (and last) thing I usually do is hide Excel
during execution of my programm; this looks much nicer
and brings a macro closer to being a "real" program.
I also can put a shortcut to the .xls-file on the
desktop and double-clicking opens my window.
Thus,
Private Sub UserForm_Initialize()
 Excel.Application.Visible = False
 ' other stuff here
End Sub
Private Sub UserForm_Terminate()
 ' this line closes excel if there's only one open
 ' workbook. only makes sense if macro is debugged
 ' otherwise excel shuts down after each run.
 If Excel.Workbooks.Count = 1 Then 
Excel.Application.Quit
 Else
Excel.Application.Visible = True
 End If
End Sub
does the trick.
Window-Positions
----------------
I want my applications to remember their window positions
and to come up with the windows where I left them.
With VBA, there is a knack to it:
as the Visible-property of a form is read-only,
you must call the Show routine if the form is to be
shown after a Hide call (see below why one would want to
hide a form). This shows the form not at the previous
position but at the default position. So we need a flag
and a file to store the positions:
Private hasPos as Boolean
Private Sub UserForm_Initialize()
 hasPos = False
End Sub
Private Sub UserForm_Activate()
 If Not hasPos Then
hasPos = True
recallWinPos ' this routine reads top and left
' from a file and sets the form
' top and left properties
 End If
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
 ' do this in QueryClose event as in
 ' Terminate event top and left are meaningless
 storeWinPos Me.left, Me.top
End Sub
Minimize Window
---------------
It's really annoying that the VBA forms don't have a
Minimize box and that they don't show up in the task bar.
It might be possible to create standard windows using
API calls and/or custom OCXs; however I wanted a solution
using only VBA built-in functions (plus, I have to admit,
some API calls).
After some thoughts I came up with the idea to add an icon
to the Sys-Tray and show or hide the window when the user
clicks into that icon. Adding an icon to the systray is a
piece of cake; the code is readily available quite a few
times at this site. The first problem is to obtain the
window handle of the form as this is NOT a property.
That's where a usefull API call comes in:
Public Declare Function GetActiveWindow Lib "user32" () As Long
Private Sub UserForm_Activate()
 myHWnd = GetActiveWindow
End Sub
Still crazy after all these programming-years, I supplied
this handle to the NOTIFYICONDATA structure expecting
a click into the tray icon showing up in the UserForm_MouseMove
event - naaaaahh....
Using the APISpyer by Steve Weller, I learned that the handle
returned only "covers" the non-client area (caption and border)
of the form; the "body" has it's own window handle.
How to find it? Well, that's where another API call comes in handy:
Public Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWndParent As Long, ByVal hWndChildAfter As Long, ByVal lpClassName As String, ByVal lpWindowName As String) As Long
We "only" need to know the class name of our window; that'd do the trick.
Here is another tool from this site of help,
the Window Explorer. It browses through all windows
plus all child windows. It tells me that the class name
in question is "F3 Server 60000000".
Thus, here's what we need to do:
Private Sub UserForm_Activate()
 myHWnd = FindWindowEx(GetActiveWindow, 0, "F3 Server 60000000", "")
End Sub
OK, now a click in the tray icon throws a MouseMove event.
The button being pressed or released is coded in the X parameter
which is not very convenient:
Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
 Dim msg As Long
 ' if from tray, button=1 and y=0
 If (Button = 1) And (Y = 0) Then
msg = (X * 4) / 3
If msg = WM_LBUTTONUP Then ShowOrHideMe
 End If
End Sub
The call to ShowOrHideMe checks wether the from is
visible and shows or hides it, accordingly.
However, as mentioned before, the UserForm.Visible
property can't be used as it is read-only.
So we'd have to use the .Hide and .Show routines.
But this is a pain in the butt as after a Show our
form shows up at the design-time position rather
than where we put it (that's because it's a modal form).
At that time, I grew tired of using more flags
in the Activate event. I decided to move the form
off-screen rather than hiding it:
If isVisible Then
 visPos_left = Me.left
 visPos_top = Me.top
 Me.left = 0
 Me.top = 65535
Else
 Me.left = visPos_left
 Me.top = visPos_top
 Me.Repaint
 winToTop
End If
isVisible = Not isVisible
The winToTop routine does what the name tells us: it
brings the window on top of all other things.
It took me a while to get it to work as all obvious
methods (send WM_ACTIVATEAPP, send WM_LBUTTONDOWN
followed by WM_LBUTTONUP, call BringWindowToTop) didn't
do it. So, more APIs:
Public Type RECT
 left As Long
 top As Long
 right As Long
 bottom As Long
End Type
Public Declare Function GetWindowRect Lib "user32.dll" (ByVal hwnd As Long, lpRect As RECT) As Long
Public Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Sub winToTop()
 Dim xcoord As Long, ycoord As Long
 Dim winrect As RECT ' receives coordinates of the window
 GetWindowRect myHWnd, winrect
 xcoord = (winrect.right - winrect.left)
 ycoord = (winrect.bottom - winrect.top)
 SetWindowPos myHWnd, HWND_TOPMOST, winrect.left, winrect.top, xcoord, ycoord, 0
End Sub
Note that myHWnd is the window handle of the non-client window
(the mother of our windows), NOT the "F3 Server 60000000" child
window handle.
I'm sure there are other ways to bring the window to top
but winToTop works and I was too lazy to dig further into it.
All in all, this is not very satisfying.
-we need to know the class name of the "body" window.
 If for some reason this name changes, we're stuck.
-A click into the tray is NOT distinguishable from
 a 'real' MouseMove event - if a user keeps the left
 mouse button pressed and moves the mouse around, he can
 trigger a tray event thus hiding our form.
What other options do we have? Well, with VB it's easy
to do: sub-class the window function associated with
our form, tell the tray icon to use a custom event
(e.g. WM_USER + &H100) and intercept that event.
To do that we need to know the address of our VB
sub-classing function which can be done by using
the AddressOf operator.
Now, this guy doesn't exist in VBA.
But Edwin Vermeer showed on this site a way to do it
in VBA (I recommend reading his article, it's brilliant):
Public Declare Function GetCurrentVbaProject Lib "vba332.dll" Alias "EbGetExecutingProj" (hProject As Long) As Long
Public Declare Function GetFuncID Lib "vba332.dll" Alias "TipGetFunctionId" (ByVal hProject As Long, ByVal strFunctionName As String, ByRef strFunctionId As String) As Long
Public Declare Function GetAddr Lib "vba332.dll" Alias "TipGetLpfnOfFunctionId" (ByVal hProject As Long, ByVal strFunctionId As String, ByRef lpfn As Long) As Long
Public Function AddrOf(strFuncName As String) As Long
 
 Const NO_ERROR = 0
 
 Dim hProject As Long
 Dim lngResult As Long
 Dim strID As String
 Dim lpfn As Long
 Dim strFuncNameUnicode As String
 
 
 AddrOf = 0
 ' The function name must be in Unicode, so convert it.
 strFuncNameUnicode = StrConv(strFuncName, vbUnicode)
 ' Get the current VBA project
 Call GetCurrentVbaProject(hProject)
 ' Make sure we got a project handle... 
 ' we always should, but you never know!
 If hProject <> 0 Then
' Get the VBA function ID
lngResult = GetFuncID(hProject, strFuncNameUnicode, strID)
If lngResult = NO_ERROR Then
 ' Get the function pointer.
 lngResult = GetAddr(hProject, strID, lpfn)
 If lngResult = NO_ERROR Then
AddrOf = lpfn
 End If
End If
 End If
End Function
Now, we can "hook" our windows function:
Public Const WM_USER = &H400
Public Const WM_MYTRAYEVENT = WM_USER + &H100
Public lpfnOldWinProc As Long
Public Sub setHook(hWnd As Long, strFunction As String)
 Dim lpNewFunc As Long
 lpNewFunc = AddrOf(strFunction)
 If lpNewFunc = 0 Then Exit Sub
 If lpfnOldWinProc <> 0 Then unsetHook hWnd
 lpfnOldWinProc = SetWindowLong(hWnd, GWL_WNDPROC, lpNewFunc)
End Sub
Public Sub unsetHook(hWnd As Long)
 On Error Resume Next
 If lpfnOldWinProc = 0 Then Exit Sub
 SetWindowLong hWnd, GWL_WNDPROC, lpfnOldWinProc
 lpfnOldWinProc = 0
End Sub
Public Function hookFunc(ByVal hWnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
 If msg = WM_MYTRAYEVENT Then
If lParam = WM_LBUTTONUP Then ShowOrHideMe
 End If
 hookFunc = CallWindowProc(ByVal lpfnOldWinProc, ByVal hWnd, ByVal msg, ByVal wParam, ByVal lParam)
End Function
So, in the UserForm_Initialize event, init all flags etc.
In Activate, call setHook(GetActiveWindow,"hookFunc")
after putting an icon into the systray (as the Activate
event might be called more than once, use a flag to make
sure setHook gets called only once!).
In Terminate, call unsetHook.
This works reliably and is more professional
than the previous solution.
CAUTION! Never set a break point in your hookFunc
and ALWAYS use the close box to stop your program
or anything can happen! Save your project before
running it, just in case...
Improvements
------------
Well, there's an easy one (I still was too lazy
to implement it) and a tough one:
-if the form is covered by other forms, you need two
 tray clicks to show it - should be only one.
-it still bugs my that the form does not show up
 in the task bar - anyone got an idea?
Update
I've added the text of this article as a zip file.

winzip iconDownload article

Note: Due to the size or complexity of this submission, the author has submitted it as a .zip file to shorten your download time. Afterdownloading it, you will need a program like Winzip to decompress it.Virus note:All files are scanned once-a-day by Planet Source Code for viruses, but new viruses come out every day, so no prevention program can catch 100% of them. For your own safety, please:
  1. Re-scan downloaded files using your personal virus checker before using it.
  2. NEVER, EVER run compiled files (.exe's, .ocx's, .dll's etc.)--only run source code.
  3. Scan the source code with Minnow's Project Scanner

If you don't have a virus scanner, you can get one at many places on the net including:McAfee.com


Report Bad Submission
Use this form to tell us if this entry should be deleted (i.e contains no code, is a virus, etc.).
This submission should be removed because:

Your Vote

What do you think of this article (in the Intermediate category)?
(The article with your highest vote will win this month's coding contest!)
Excellent  Good  Average  Below Average  Poor (See voting log ...)
 

Other User Comments


 There are no comments on this submission.
 

Add Your Feedback
Your feedback will be posted below and an email sent to the author. Please remember that the author was kind enough to share this with you, so any criticisms must be stated politely, or they will be deleted. (For feedback not related to this particular article, please click here instead.)
 

To post feedback, first please login.