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

我正在做一个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”列中的date，只要该行中的任何其他项目被编辑。 大！ 解决，除了…

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

所以，另外一个办法就是让excel进入思维，我没有编辑过单元格。 此代码在更改date时保留撤消堆栈：

 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 

在这种情况下，我们select单元格，使用SendKeys来伪造单元格，并将光标恢复到原始位置。 “^;〜”是使用Excel的“Ctrl +”; inputdate的快捷方式。 大！ 解决，除了…

此代码在我的机器（Win7，Excel 2010）上正常工作，但在同事的计算机上失败（Win8，Excel 2010，可能更快）。 在Win8机器上（不知道是否是操作系统，这是问题，顺便说一句），会发生什么情况是，每当一个单元格被更改，紧接着该单元格下面的每个单元格成为当前date，当然保留撤消历史是没有意义的，因为执行撤消会立即重新激活工作表代码并将所有内容重新转换为date。

我自己想出了，如果我删除SendKeys命令中固有的“Wait”，我的机器上也会发生同样的事情。 也就是说，如果我使用这一行：

 SendKeys "^;~", False 

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

Answer 1

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

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

 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