Double Click Event on Shapes

Question

In my research, I've found that there is no built in functionality for enabling double click events on Shapes on an excel sheet. Many of the workarounds I saw involved writing classes or other such things to add this functionality, all of which seemed a bit beyond my VBA knowledgebase. Hence, I wrote the above code (currently just as a test) to attempt to write my own Double click functionality for shapes.

Public Clicked As Boolean, LastClickObj As String, LastClickTime As Date


Sub GenerateShapes()
    Dim sheet1 As Worksheet, shape As shape
    Set sheet1 = ThisWorkbook.Worksheets("Sheet1")
    Set shape = sheet1.Shapes.AddShape(msoShapeDiamond, 50, 50, 5, 5)
        shape.OnAction = "ShapeDoubleClick"
    Set shape = sheet1.Shapes.AddShape(msoShapeRectangle, 50, 60, 5, 5)
        shape.OnAction = "ShapeDoubleClick"
    LastClickTime = Now
End Sub


Sub ShapeDoubleClick()

    If Second(Now) - Second(LastClickTime) > 0.5 Then
        Clicked = False
        LastClickObj = ""
        LastClickTime = Now
    Else

        If Not Clicked Then
            Clicked = True
            LastClickObj = Application.Caller
        ElseIf LastClickObj = Application.Caller Then
            MsgBox ("Double Click")
            Clicked = False
            LastClickObj = ""
            LastClickTime = Now - 1
        Else
            LastClickObj = Application.Caller
            Clicked = True
            LastClickTime = Now
        End If
    End If


End Sub

However, given the way I've encorporated the timer, the code often will only execute the "Double click" if I click three times in rapid succession. I think it has something to do with how I am handling the time-out "resetting" of Clicked, but there could be other issues with the logic. Any ideas on how to properly implement this functionality without other extensive additions (like Classes and such)?

Answer 1

Spent some more time looking at this and realized with some debugging that the triple click was caused by my clicked boolean. The solution I have below works perfectly, including shape distinctions, and the click delay can be easily adjusted in the code (I may adjust that to be a variable set elsewhere, but for now hardcode functionality is sufficient). Posting my solution here for future users who wish to add Double Click actions to their shapes

Option Explicit

Public LastClickObj As String, LastClickTime As Date

Sub ShapeDoubleClick()

    If LastClickObj = "" Then
        LastClickObj = Application.Caller
        LastClickTime = CDbl(Timer)
    Else
        If CDbl(Timer) - LastClickTime > 0.25 Then
            LastClickObj = Application.Caller
            LastClickTime = CDbl(Timer)
        Else
            If LastClickObj = Application.Caller Then
                MsgBox ("Double Click")
                LastClickObj = ""
            Else
                LastClickObj = Application.Caller
                LastClickTime = CDbl(Timer)
            End If
        End If
    End If

End Sub