Search Tools Links Login

VBA-macros as


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.

Original Author: Norbert Schaefer

Code

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.

About this post

Posted: 2002-06-01
By: ArchiveBot
Viewed: 97 times

Categories

Visual Basic 6

Attachments

VBA-macros26001962001.zip
Posted: 9/3/2020 3:45:00 PM
Size: 5,678 bytes


Loading Comments ...

Comments

No comments have been added for this post.

You must be logged in to make a comment.