Mouse-Over State on Graphic Button
Hi Wayne,
Using an API timer as shown below, you can use "rapid polling" to monitor
the state of just about anything that takes your fancy. When it's state
changes, your code can react accordingly. Essentially, this allows you to
create your own events. (Very useful considering the relatively small number
of built-in events in Excel's object model.)
In this example, I've placed 4 pictures onto the worksheet, and named them
"Button1_In" and "Button1_Out" , and
"Button2_In" and "Button2_Out" .
Button1_In and Button1_Out are exactly the same size, and one is aligned
exactly over the top of the other. The same can be said for the second pair
of pictures.
The following code is placed in a standard module. The StartTimer macro will
initiate the rapid polling. The StopTimer macro will turn it off. It is
best to leave it off whenever possible, as SetTimer has the capability of
crashing Excel in some situations. It can also cause flashing of the VBE's
main caption.
Regards,
Vic Eldridge
Declare Function SetTimer Lib "user32" _
(ByVal hwnd As Long, _
ByVal nIDEvent As Long, _
ByVal uElapse As Long, _
ByVal lpTimerFunc As Long) As Long
Declare Function KillTimer Lib "user32" _
(ByVal hwnd As Long, _
ByVal nIDEvent As Long) As Long
Declare Function GetCursorPos Lib "user32" _
(lpPoint As POINTAPI) As Long
Type POINTAPI
x As Long
Y As Long
End Type
Dim TimerOn As Boolean
Dim TimerId As Long
Sub StartTimer()
If Not TimerOn Then
TimerId = SetTimer(0, 0, 0.01, AddressOf TimerProc)
TimerOn = True
Else
MsgBox "Timer already On !", vbInformation
End If
End Sub
Sub StopTimer()
If TimerOn Then
KillTimer 0, TimerId
TimerOn = False
Else
MsgBox "Timer already Off", vbInformation
End If
End Sub
Sub TimerProc()
Dim ObjectUnderCursor As Object
Dim CursorPos As POINTAPI
On Error Resume Next
GetCursorPos CursorPos
Set ObjectUnderCursor = ActiveWindow.RangeFromPoint(CursorPos.x,
CursorPos.Y)
Select Case TypeName(ObjectUnderCursor)
Case "Range", "Nothing"
ActiveSheet.Shapes("Button1_Out").ZOrder msoBringToFront
ActiveSheet.Shapes("Button2_Out").ZOrder msoBringToFront
End Select
Select Case ObjectUnderCursor.Name
Case "Button1_Out"
ActiveSheet.Shapes("Button1_In").ZOrder msoBringToFront
Case "Button2_Out"
ActiveSheet.Shapes("Button2_In").ZOrder msoBringToFront
End Select
End Sub
"TheVisionThing" wrote:
I'm using a number of different buttons on a worksheet in the form of
imported gif images to run a VBA driven menu. The buttons are on the
worksheet, not on a command bar. Is there any kind of mouse-over event that
would allow me to swap out graphic images on the button?
Thanks,
Wayne C.
|