Search code examples
excelvbaexcel-formulaactivex

Execute Macros on Single & Double Click on Shapes in VBA


I have 12 Shapes named (Jan till Dec) and I have only one Agenda for those buttons, if the shape is clicked once, then the Name of the Shape has to be updated in J4 Cell and if any shape is clicked twice, the Name of the Shape has to update in M4 Cell. I have researched the code and tried to figure out the code from one of the Answers provided (Double Click Event on Shapes) and the following code I'm using:

Public LastClickObj As String, LastClickTime As Date
Set Wb = ThisWorkbook
Set WsCharts = Wb.Sheets("Trend Charts")
Set UBMainChart = WsCharts.ChartObjects("UBMainChart")
Set UBMonthlyYTDSht = Wb.Worksheets("UM - Monthly & YTD Trend")
btnMonthName = WsCharts.Shapes(Application.Caller).Name

    If LastClickObj = "" Then
        LastClickObj = Application.Caller
        LastClickTime = CDbl(Timer)
    Else
        If CDbl(Timer) - LastClickTime > 0.25 Then
            LastClickObj = Application.Caller
            LastClickTime = CDbl(Timer)
            WsCharts.Range("J4").Value = btnMonthName
        Else
            If LastClickObj = Application.Caller Then
                MsgBox ("Double Click")
                LastClickObj = ""
                WsCharts.Range("M4").Value = btnMonthName
            Else
                LastClickObj = Application.Caller
                LastClickTime = CDbl(Timer)
            End If
        End If
    End If

The problem is that even If I do a Single Click or Double Click, the value is updating only in J4 Cell which naturally taking it as a Single Click. I don't understand where it is going wrong.

Appreciate your help!


Solution

  • I have figured out myself without multiple Clicks... The Code works in the below-mentioned process:

    1. First Click on any of the Buttons - Macro updates the required value in J4 Cell
    2. Second Click on any of the Buttons - This time it cross-checks whether the same button is clicked or not and If the same button is clicked, it will exit the code, else it will update the value in M4 Cell. Hence the problem is Solved!!
    3. This cycle follows every time...

    Following the code I used:

    If LastClickObj = "" Then
        LastClickObj = Application.Caller
        WsCharts.Range("J4").Value = btnMonthName
    Else
        If LastClickObj = Application.Caller Then
            Exit Sub
        Else
           WsCharts.Range("M4").Value = btnMonthName
           LastClickObj = ""
        End If
    End If