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

Question

我正在处理一个 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 命令完成，但我同事的计算机却没有。有什么想法吗？

Answer 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