Событие с двойным щелчком по фигурам

Question

В моем исследовании я обнаружил, что нет встроенных функций для включения событий двойного щелчка на фигурах на листе excel. Многие из обходных решений, которые я видел, касались написания классов или других подобных вещей, чтобы добавить эту функциональность, все из которых казались немного выше моей базы знаний VBA. Следовательно, я написал вышеприведенный код (в настоящее время как тест), чтобы попытаться написать собственную функцию двойного щелчка для фигур.

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 

Однако, учитывая то, как я encorporated таймера, код часто будет только выполнить «двойной щелчок», если я нажимаю три раза в быстрой последовательности. Я думаю, что это имеет какое-то отношение к тому, как я обрабатываю тайм-аут «перезагрузки» Clicked, но могут быть другие проблемы с логикой. Любые идеи о том, как правильно реализовать эту функцию без других обширных дополнений (например, Классы и т. Д.)?

Answer 1

Затраченное еще некоторое время, смотря на это и понял, с некоторой отладкой, что тройной щелчок был вызван моим щелкнули булевым. Решение, которое у меня ниже, прекрасно работает, включая различия в форме, и задержка щелчка может быть легко скорректирована в коде (я могу настроить это как переменную, установленную в другом месте, но на данный момент для работы с жестким кодом достаточно). Проводка моего решения здесь для будущих пользователей, которые хотят добавить двойной щелчок мыши действия по их форме

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 

Answer 2

EDIT 3: Я использовал свой начальный формат без ячеек трекера для этого: Я думаю, он округляет время, поэтому вам нужно будет использовать синтаксис, который я использовал выше, чтобы заставить его работать в миллисекундах. Предотвращает тройной щелчок при активации двух двойных щелчков.

Sub ShapeDoubleClick() 

    Debug.Print Second(Now) - Second(LastClickTime) 

    If Second(Now) - Second(LastClickTime) > 0.3 Then 
     LastClickTime = Now 

    ElseIf LastClickObj = Application.Caller And Clicked = False Then 

      Debug.Print "Double Clicked!" 
      Clicked = True 
      LastClickTime = Now - 1 
      LastClickObj = Application.Caller 
      Exit Sub 

    End If 

    Clicked = False 
    LastClickObj = Application.Caller 
End Sub