雙擊形狀上的事件

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

編輯3：我用你的初始格式沒有跟蹤單元這個： 我認爲它會縮短時間，所以你不得不使用上面使用的語法來使它在毫秒中工作。阻止三次點擊激活2次雙擊。

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