双击形状上的事件

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