Home > Net >  Execute Macros on Single & Double Click on Shapes in VBA
Execute Macros on Single & Double Click on Shapes in VBA

Time:11-15

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!

CodePudding user response:

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
  • Related