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机器上(不知道它是操作系统是什么问题,顺便说一下),会发生的情况是,每当一个单元格被更改时,紧接在该单元格下面的每个单元格都会成为当前日期,当然保留撤销历史记录是没有意义的,因为执行撤消会立即重新激活工作表代码并再次将所有内容转换为日期.

我自己想出,如果我删除了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