Create a Rollover Shape Button

Read how to Create a Rollover Shape Button by Mark Kubiszyn · 2010, 2013 & 2016 (32bit & 64bit)

#back



A Step-by-step Guide

Follow the tutorial below to create your own Button or purchase the finished Zip Archive with all of the examples including multiple Buttons and Button Navigation via FastSpring >> Create a Rollover Shape Button
As an incentive to purchase the Zip Archive, I will add more Buttons (using a special enabling tweak to the Timer Proc Code) and a couple of effects!

Why use the Rollover technique? Well because it's lighteningly fast, and I have found it as quick, if not quicker than using a Label MouseOver event - remember Shapes do not have such an event, so this combination of Hyperlink Rollover and Shape produces a lovely Button action. Check out my second generation of Rollover Buttons available to purchase Rollover Burger Buttons

This is a Screen Shot of a second generation Rollover Burger Button using a Spin Animation on a Magnifier Icon:

Rollover Burger Button Animated Spin Magnifier Screen Shot Popup Menu

Love Rollover Buttons but don't want to purchase? Check out these Free download Files - Mint & Chocolate Rollover Buttons, Widget Rollover Buttons, UI Element Rollover Buttons, Lots of Rollover Button Examples, Rollover Toolbar Sheet Navigator using Font Awesome, Rollover Toolbar or Search Rollover here >> Free Stuff




Abstract

Okay so we are going to build a Rollover Button using a Hyperlink Rollover (remember Jordan Goldmeirs' Rollover technique presented a few years ago?), well we are going to be using one of those, a Shape and some nifty timing to produce an awesome, fast, smooth action Rollover Shape Button with click capture to run a Macro. You can follow along and create the Rollover Button for Free or purchase it as a finished Workbook for £2.99 on the link above. It will give you a little insight into my 'very' strange mind and at the same time hopefully help develop your VBA skills. Oh and if you liked this article, why not add some easing Functions to your Projects - check them out here >> easing Functions v1.2


Step 1 - getting the Hyperlink Rollover & Shape working for a Rollover & Mouse Click

So open a new Excel Workbook and save the File. Resize Column "B" to have a Column Width of '28' and resize Row "3" to have a Row Height of '48'. In Cell "B3", format the Cell to have 'Word Wrap' using right-click 'Format Cells...' and on the Alignment Tab click 'wrap text' underneath 'Text control'. Now add the following Formula to the Cell "B3" - this is the Hyperlink Rollover call to the 'foo' Function (Please Note: ths can be a normal Subroutine, but you can use it as a Function too to bring back a value for the Rollover):

=IFERROR(HYPERLINK(foo("button1")),"")

Add a Rectangle Shape to the Worksheet from the Illustrations Group of the INSERT Tab on the Ribbon. Using the Selection Pane on the Arrange Group of the PAGE Layout Tab on the Ribbon, change the name to button1. Resize the Button to the area of the Cell "B3". Right-click on the Shape and select Format Shape. Change the Fill and Line solid Colours to RGB(34, 111, 190) using more Colours (click on the tiny Paint Pot). Now type the Text 'BUTTON' on the Shape and centre both Vertically and Horizontally. Format the Font Colour to be white and Bold. Lastly right-click on the Shape and select Assign Macro... - select the Macro 'Button1'


Press ALT+F11 to enter the VBA Code Editor and insert a new Code Module, File Menu->Insert->Module. Name the Module 'mdRollover'. Enter the following Code:

Option Explicit

Public Function foo(ByVal Button As String)
    Range("A1").Value2 = Rnd(999)
    Range("B1").Value2 = Button





End Function

Public Sub Button1()
    Range("A2").Value2 = "x: " & Rnd(999)

End Sub

The Workbook is ready. When you move over the Shape Cell "A1" will output a random number. Clicking on the Shape will output another random number in Cell "A2" (I click many times in the video below). Your Workbook should now look something like the Video below - the background Colour I used is RGB(69, 147, 227):






Step 2 - adding the Timer Callback Subroutine and Code to highlight the Button (change its Transparency) and Run a Dummy Task

Great, that's our Rollover and Shape added, so now let's add the Timer Callback Subroutine and Code to highlight the Button (change its transparency) and run a dummy task. Open the Code Editor and add this Code to the top of the Code Module:

Option Explicit

' 64bit & 32bit dec's
#If VBA7 And Win64 Then
    Public Declare PtrSafe Function SetTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
    Public Declare PtrSafe Function KillTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
    Public Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
#Else
    Public Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
    Public Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
    Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
#End If

' cursor hit point type
Public Type POINTAPI
    X As Long
    Y As Long
End Type

' global vars
' - used by the Timer
Public lngTimerID
Public blnActiveTimer As Boolean
Public intTimerTick As Integer
Public strShapeName As String

' local vars
' - IsRunning, used to prevent repeated animation & Macro's from being triggered by multiple clicking
Private IsRunning As Boolean

Now update the 'foo' Rollover Function (can be a Subroutine if you want) to the following Code:

Public Function foo(ByVal Button As String)
    'Range("A1").Value2 = Rnd(999)
    'Range("B1").Value2 = Button

    If Not blnActiveTimer Then
        intTimerTick = 1
        strShapeName = Button
        StartTimer
        blnActiveTimer = True
    End If

End Function

Replace the 'Button1()' example Subroutine with the following Code to run the dummy task - this is the Macro you linked in Part 1:

' Button1, example of capturing the Click to run a dummy task
Public Sub Button1()
    'Range("A2").Value2 = "x: " & Rnd(999)

    ' prevent multiple clicks
    If IsRunning Then Exit Sub

    IsRunning = True

        ' // borrowed from Ejaz Ahmed's Class Progressbar as I liked the technique
        '    modified to stay within a Blue/Pink spectrum of Colours I like ;)
        Dim rngCell As Range
        Dim i As Double, j As Integer
        While j < 25
            DoEvents
            For Each rngCell In Range("H1:Z1").Cells
            DoEvents
                On Error Resume Next
                Randomize
                i = i + Rnd(100) - 0.1
                rngCell.Interior.Color = RGB(255 * Rnd(i), 61, 181)
                On Error GoTo 0
             Next rngCell
            j = j + 1
        Wend

    IsRunning = False

End Sub

Lastly add the Code for the Timer at the bottom of the Code Module:

'- StartTimer, starts the Timer Thread
'   - initialise the Timer Tick
'   - pass the name of the Timer procedure that will receive callback
Sub StartTimer()
    intTimerTick = 1
    lngTimerID = SetTimer(0&, 0&, 0.01 * 1000&, AddressOf TimerProc)
    Debug.Print "Timer thread started"
End Sub

'- EndTimer, ends the Timer Thread
'   - kill the Timer Thread
'   - reset the global Boolean variable
Sub EndTimer()
    KillTimer 0&, lngTimerID
    blnActiveTimer = False
    Debug.Print "Timer thread ended"
End Sub

'- TimerProc, low-level timer callback Subroutine
'   - tracks whether the cursor is over our Shape
'   - kills the timer when the cursor is no longer over any Shape
Sub TimerProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal nIDEvent As Long, ByVal dwTimer As Long)
    On Error Resume Next
    Debug.Print "timer proc call:" & intTimerTick
    ' set this to 3 so that faster machines detect the hits
    If intTimerTick > 3 Then
        Dim objPoint As POINTAPI
        Dim objShape As Shape
        GetCursorPos objPoint
        Set objShape = ActiveSheet.Shapes(ActiveWindow.RangeFromPoint(objPoint.X, objPoint.Y).Name)
        If Not objShape Is Nothing Then
            If objShape.Name = strShapeName Then
                objShape.Fill.Transparency = 1
            End If
            intTimerTick = 1
        Else
            ActiveSheet.Shapes(strShapeName).Fill.Transparency = 0
            EndTimer
        End If
    End If
    intTimerTick = intTimerTick + 1
End Sub

That's it - now test out the Button. Here is a video of the finished Workbook with the Rollover Shape Button in action running a dummy task. I have opened the Immediate Window (used for debugging...) so that you can see the entire Rollover process with the Timer Threads being started and killed. You will note that the task can be clicked many times, but will only run once. The Button will remain in its highlighted or 'Rolled over' state whilst the Mouse is over it. The Button action is super fast, smooth and responsive to the Mouse click. You can even remain on the Button and click to run the Macro more than once. Moving away from the Button will see it return to its full transparency:






More Buttons are required!

If you want more Buttons then please Purchase the Workbook where I have included a File showing you just that. One Button runs a dummy task and the other Button navigates to a different Worksheet - 2 changes are neccesary to the Code. Here is a video of the extra Workbook:






A Group of Buttons

Here is a video of a Group of Buttons. Notice that I have removed the Background Fill and Formatted the Shapes to be much more lightweight. This example is included if you Purchase the Workbook






A Group of Buttons that have their Foreground & Font Colour Changed instead of Transparency

Of course, you are not limited to setting just the Transparency. Here is a video where I change both the Button Foreground Colour and the Font Colour when a Button is 'Rolled over'. This example is included if you Purchase the Workbook