Excel VBA：SendKeys 在某些计算机上失败

Posted 2023-04-19

【中文标题】Excel VBA：SendKeys 在某些计算机上失败

【英文标题】：Excel VBA: SendKeys fails on some computers

【发布时间】：2014-10-28 20:58:01

【问题描述】：

我正在处理一个 Excel 表，其中每一行都需要指明该行中的任何单元格最后一次更改的时间。我发现的最简单的方法是在工作表代码中放入少量 VBA，如下所示：

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
    If (Target.Row > 2) And (Cells(Target.Row, "A") <> "") Then
        Cells(Target.Row, "N").Value = Date
    End If
    Application.EnableEvents = True
End Sub

每当编辑该行中的任何其他项目时，这将有效地更改“N”列中的日期。伟大的！解决了，除了...

因为我正在更改代码中的单元格值，所以撤消堆栈会立即丢失，当然这意味着此工作表中的任何工作都无法撤消。

因此，另一种方法是诱使 excel 认为我没有编辑单元格。此代码在更改日期时保留撤消堆栈：

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim cursorLocation As Range
    Application.EnableEvents = False
    If Target.Row > 2 And Cells(Target.Row, "A") <> "" Then
        Set cursorLocation = ActiveCell
        Cells(Target.Row, "N").Select
        SendKeys "^;~", True
        cursorLocation.Select
    End If
    Application.EnableEvents = True
End Sub

在这种情况下，我们选择单元格，使用 SendKeys 伪造编辑单元格，并将光标恢复到其原始位置。 "^;~" 使用 Excel 的 "Ctrl+;"输入日期的快捷方式。伟大的！解决了，除了……

此代码在我的机器（Win7、Excel 2010）上运行良好，但在同事的机器上失败（Win8、Excel 2010，可能更快一些）。在 Win8 机器上（不知道问题是否出在操作系统上，顺便说一句），发生的情况是，每当更改单元格时，该单元格下方的每个单元格都会成为当前日期，当然保留撤消历史记录是没有意义的，因为执行Undo 立即重新激活工作表代码并将所有内容再次转换为日期。

我自己发现，如果我删除 SendKeys 命令中固有的“等待”，我的机器上也会发生同样的事情。也就是说，如果我使用该行：

SendKeys "^;~", False

所以，我的猜测是，无论出于何种原因，即使使用相同版本的 Excel，我的计算机也在等待 SendKeys 命令完成，但我同事的计算机却没有。有什么想法吗？

【问题讨论】：

为了其他人的利益，我更改了“如果”以允许您手动更改日期：If Target.Row > 2 And Cells(Target.Row, "A") <> "" And Target.Column <> 14

【参考方案1】：

你是对的。它在 Excel 2010/Win8 中给出了这个问题。

试试这个。使用我编写的自定义Wait 代码。 （在 Excel 2010/Win8 中测试）

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim cursorLocation As Range
    Application.EnableEvents = False
    If Target.Row > 2 And Cells(Target.Row, "A") <> "" Then
        Set cursorLocation = ActiveCell
        Cells(Target.Row, "N").Select
        SendKeys "^;~"
        Wait 1 '<~~ Wait for 1 Second
        cursorLocation.Select
    End If
    Application.EnableEvents = True
End Sub

Private Sub Wait(ByVal nSec As Long)
    nSec = nSec + Timer
    While nSec > Timer
        DoEvents
    Wend
End Sub

替代方案

使用Doevents也有想要的效果。

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim cursorLocation As Range
    Application.EnableEvents = False
    If Target.Row > 2 And Cells(Target.Row, "A") <> "" Then
        Set cursorLocation = ActiveCell
        Cells(Target.Row, "N").Select
        SendKeys "^;~"
        DoEvents
        cursorLocation.Select
    End If
    Application.EnableEvents = True
End Sub

【讨论】：

嗯，这肯定行得通，但在计算方面，1 秒的等待时间似乎很长。我可以使用更快的计时器吗？

查看我给的Alternative :) 您可能需要刷新页面。

...现在要弄清楚如何撤消更改该日期，如果您撤消首先使它发生变化的事情！

看看THIS 有没有帮助？还没有用 sendkeys 测试过...

我会试一试，但是，如果我有一个适当的 VBA 撤消处理程序，我一开始就不需要 SendKeys。感谢您的帮助！