双击形状上的事件

在我的研究中，我发现没有内置的function来启用Excel表单上的形状的双击事件。 我所看到的许多解决方法都是编写类或其他类似的东西来添加这个function，所有这些看起来都超出了我的VBA知识库。 因此，我写了上面的代码（目前只是作为一个testing）来尝试编写我自己的形状双击function。

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 

但是，考虑到我已经把定时器包含进去了，如果我连续点击三次，代码通常只会执行“双击”。 我认为这与我如何处理Clicked的超时“重置”有关，但是逻辑可能还有其他问题。 任何想法如何正确地实现这个function没有其他广泛的补充 （如类和类似）？

Answer 1

花更多的时间看着这个，并通过一些debugging来实现，三重点击是由我点击的布尔值引起的。 我下面的解决scheme完美地工作，包括形状区别，和点击延迟可以很容易地在代码中调整（我可以调整成为一个variables设置在别处，但现在硬编码function是足够的）。 将我的解决scheme发布给希望将双击操作添加到其形状的未来用户

 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：我用你的初始格式没有跟踪单元为此：我认为它是四舍五入的时间，所以你不得不使用我使用上面的语法，以毫秒为单位的工作。 阻止三重点击激活两次双击。

 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