Mouse-Over State on Graphic Button

[TheVisionThing]

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.

[Greg Wilson]

IMO the only realistic way to do this is to add Image controls from the
Control Toolbox toolbar and assign the desired images to their Picture
properties instead of inserting pictures directly. These support a MouseMove
event which you can harness to do the swap.

Regards,
Greg

"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.
>
>
>

[TheVisionThing]

Thanks, Greg, I'll play around with that.

Regards,
Wayne C.

"Greg Wilson" <[email protected]> wrote in message
news:[email protected]...
> IMO the only realistic way to do this is to add Image controls from the
> Control Toolbox toolbar and assign the desired images to their Picture
> properties instead of inserting pictures directly. These support a
> MouseMove
> event which you can harness to do the swap.
>
> Regards,
> Greg
>
> "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.
>>
>>
>>

[Vic Eldridge]

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.
>
>
>

[Greg Wilson]

Great contribution Vic !!!

I just checked it out. Looks like it could be the solution for the missing
"Worksheet_ScrollChange" event - i.e. capture the event of scrolling the
worksheet. Example:

Sub TimerProc()
Static ScrRw As Long
With ActiveWindow
If .ScrollRow <> ScrRw Then Range("A20") = .ScrollRow
'Note: DON'T CALL A MESSAGE BOX or will freeze !!!
ScrRw = .ScrollRow
End With
End Sub

Do you know if there is a performance problem when it is running with large
projects or other issues?

Regards,
Greg Wilson

[Vic Eldridge]

I'm glad you found another use for it Greg. It goes to show that the rapid
polling concept can be used to plug all sorts of gaps in Excel's object model.

I particularly like it when used in conjunction with GetCursorPos and
RangeFromPoint, providing us with all those mouse movement type events that
many of us have longed for. I hazard a guess that throwing GetAsyncKeystate
into the mix could provide mouse button events too. RangeFromPoint can
return ChartObjects too, so using it in conjunction with the GetChartElement
method could produce some really cool chart effects.

I adapted the code from the following post by Jaafar,
http://groups.google.com.au/group/mi...b44f8ee8e8937/
In that example, the same concept is used to monitor MouseEnter and
MouseExit events at a cell based level.

> Do you know if there is a performance problem when it is running with large
> projects or other issues?
In my experimentations I've seen Excel crash a couple of times (I'm not sure
why), and as you noticed, MsgBoxes pose a bit of a problem. Best practice
would be to stop the timer before running any other code, then start the
timer again when the other code is finished. Typically though, once the code
is fully debugged it seems to chug along quite happily. I would still
recommend using it as sparingly and as carefully as possible.

Regards,
Vic Eldridge



"Greg Wilson" wrote:

> Great contribution Vic !!!
>
> I just checked it out. Looks like it could be the solution for the missing
> "Worksheet_ScrollChange" event - i.e. capture the event of scrolling the
> worksheet. Example:
>
> Sub TimerProc()
> Static ScrRw As Long
> With ActiveWindow
> If .ScrollRow <> ScrRw Then Range("A20") = .ScrollRow
> 'Note: DON'T CALL A MESSAGE BOX or will freeze !!!
> ScrRw = .ScrollRow
> End With
> End Sub
>
> Do you know if there is a performance problem when it is running with large
> projects or other issues?
>
> Regards,
> Greg Wilson

[Greg Wilson]

Thanks for the feedback Vic.

Point of interest perhaps: This may be stating the obvious, but when a
keyboard key is remapped using Application.OnKey, when that key is held down,
it repeatedly executes the assigned macro. The effect is similar to rapid
polling but offers control at the same time. But of course you have to know
to press the key. So it's not convenient or appropriate for all situations. I
have yet to use this to any great extent but plan to experiment when I have
more time.

Currently, I use this in only one project in conjuction with GetCursorPos
and RangeFromPoint where I remapped the arrow keys and use them to cotinually
move the object (picture) that is under the mouse pointer. In this situation,
I don't want to activate the picture (the arrow keys support this already for
activated shapes). The process is very smooth with no flicker, at least on my
computer. I was thinking it could be used, as you also mentioned, for charts,
and perhaps avoid the flicker associated with MouseMove or MouseDown.

As for your code, I'm considering using Workbook_SheetActivate event to
start and stop it and would probably limit its use. There are of course
situations where you want this automatic functionality. Definately a keeper.

Regards,
Greg

"Vic Eldridge" wrote:

> I'm glad you found another use for it Greg. It goes to show that the rapid
> polling concept can be used to plug all sorts of gaps in Excel's object model.
>
> I particularly like it when used in conjunction with GetCursorPos and
> RangeFromPoint, providing us with all those mouse movement type events that
> many of us have longed for. I hazard a guess that throwing GetAsyncKeystate
> into the mix could provide mouse button events too. RangeFromPoint can
> return ChartObjects too, so using it in conjunction with the GetChartElement
> method could produce some really cool chart effects.
>
> I adapted the code from the following post by Jaafar,
> http://groups.google.com.au/group/mi...b44f8ee8e8937/
> In that example, the same concept is used to monitor MouseEnter and
> MouseExit events at a cell based level.
>
> > Do you know if there is a performance problem when it is running with large
> > projects or other issues?
> In my experimentations I've seen Excel crash a couple of times (I'm not sure
> why), and as you noticed, MsgBoxes pose a bit of a problem. Best practice
> would be to stop the timer before running any other code, then start the
> timer again when the other code is finished. Typically though, once the code
> is fully debugged it seems to chug along quite happily. I would still
> recommend using it as sparingly and as carefully as possible.
>
> Regards,
> Vic Eldridge
>
>
>
> "Greg Wilson" wrote:
>
> > Great contribution Vic !!!
> >
> > I just checked it out. Looks like it could be the solution for the missing
> > "Worksheet_ScrollChange" event - i.e. capture the event of scrolling the
> > worksheet. Example:
> >
> > Sub TimerProc()
> > Static ScrRw As Long
> > With ActiveWindow
> > If .ScrollRow <> ScrRw Then Range("A20") = .ScrollRow
> > 'Note: DON'T CALL A MESSAGE BOX or will freeze !!!
> > ScrRw = .ScrollRow
> > End With
> > End Sub
> >
> > Do you know if there is a performance problem when it is running with large
> > projects or other issues?
> >
> > Regards,
> > Greg Wilson