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機器上（不知道是否是操作系統是問題，btw），會發生什麼情況是，每當單元格發生更改時，該單元格下方的每個單元格都將成爲當前日期，並且當然保留撤消歷史記錄是沒有意義的，因爲執行撤消會立即重新激活工作表代碼並將所有內容重新轉換爲日期。

我自己想出瞭如果刪除SendKeys命令中固有的「Wait」，我的機器上也會發生同樣的事情。也就是說，如果我用線：

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