View Single Post
  #4   Report Post  
Posted to microsoft.public.excel.programming
Vic Eldridge[_3_] Vic Eldridge[_3_] is offline
external usenet poster
 
Posts: 112
Default 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.