vba - Excel VBA : SendKeys fails on some computers

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 机器上(顺便说一句，不知道是否是操作系统的问题)，每当更改一个单元格时，紧邻该单元格下方的每个单元格都会变成当前日期，当然保留撤消历史记录是没有意义的，因为执行撤消会立即重新激活工作表代码并将所有内容再次转换为日期。

我自己发现，如果删除 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