在我的研究中,我发现没有内置功能可以在 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
但是,考虑到我合并计时器的方式,如果我快速连续单击三次,代码通常只会执行“双击”。 我认为这与我如何处理
Clicked
的超时“重置”有关,但逻辑上可能存在其他问题。关于如何正确实现此功能的任何想法无需其他大量添加(如类等)?
花了更多时间查看此问题,并通过一些调试意识到三次单击是由我单击的布尔值引起的。 我下面的解决方案工作得很好,包括形状区别,并且可以在代码中轻松调整点击延迟(我可以将其调整为其他地方设置的变量,但目前硬编码功能就足够了)。 在这里发布我的解决方案,供未来希望向其形状添加双击操作的用户
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
编辑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
更改为 如果 (Now() - LastClickTime) * 86400 * 2 > 1 那么 最后点击时间 = 现在 我相信双击需要半秒 谢谢,这真的很有用。我总是很恼火,当双击枢轴单元格并打开一个新工作表时,如果您离开该工作表,它会无条件地保留,并且必须稍后有意删除。现在,我使用工作簿事件向新生成的工作表添加形状/注释警告“如果关闭,此工作表将自动删除。为防止这种情况,您可以在名称后添加下划线或更改名称,以便前 5 个字符不是“工作表” ' 双击该注释即可将其删除。”如果名称尚未更改,退出工作表时会立即给出删除该工作表的选项。