Excel VBA: SendKeys không thành công trên một số máy tính

Question

Tôi đang làm việc trên một bảng tính nổi trội trong đó mỗi hàng cần chỉ ra thời gian cuối cùng mà bất kỳ ô nào trong hàng đó đã thay đổi. Phương pháp đơn giản nhất tôi đã tìm thấy để làm điều này là đặt một số lượng nhỏ VBA vào mã trang tính, như vậy:

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 

Điều này sẽ thay đổi ngày trong cột "N" một cách hiệu quả bất cứ khi nào có bất kỳ mục nào khác trong hàng đó được chỉnh sửa. Tuyệt quá! Giải quyết, ngoại trừ ...

Vì tôi đang thay đổi giá trị ô trong mã, ngăn hoàn tác bị mất ngay lập tức và dĩ nhiên điều này có nghĩa là BẤT K work công việc trong trang tính này không thể hoàn tác.

Vì vậy, một giải pháp thay thế cho điều này là lừa nổi suy nghĩ rằng tôi chưa chỉnh sửa ô. Mã này giữ gìn lùi lại ngăn xếp trong khi thay đổi ngày:

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 

Trong trường hợp này, chúng tôi chọn các tế bào, SendKeys sử dụng để chỉnh sửa giả trong tế bào, và khôi phục lại con trỏ đến vị trí ban đầu của nó. "^; ~" đang sử dụng "Ctrl +;" của Excel phím tắt để nhập ngày tháng. Tuyệt quá! Giải quyết, ngoại trừ ...

Mã này hoạt động tốt trên máy tính của tôi (Win7, Excel 2010) nhưng không hoạt động trên máy của đồng nghiệp (Win8, Excel 2010, có thể nhanh hơn một chút). Trên máy Win8 (không biết đó là hệ điều hành có vấn đề, btw), điều gì xảy ra là bất cứ khi nào một ô bị thay đổi, mọi ô ngay bên dưới ô đó sẽ trở thành ngày hiện tại, và tất nhiên bảo toàn lịch sử Undo là vô nghĩa vì thực thi một Hoàn tác ngay lập tức kích hoạt lại mã trang tính và biến mọi thứ thành ngày một lần nữa.

Tôi đã tự mình phát hiện ra rằng điều tương tự sẽ xảy ra trên máy của tôi nếu tôi xóa "Đợi" vốn có trong lệnh SendKeys. Đó là, nếu tôi sử dụng dòng:

SendKeys "^;~", False 

Vì vậy, những gì tôi đoán là vì lý do gì, ngay cả khi sử dụng cùng một phiên bản của Excel, máy tính của tôi đang chờ chỉ huy SendKeys để kết thúc, nhưng máy tính của đồng nghiệp của tôi thì không. Bất kỳ ý tưởng?

Answer 1

Bạn nói đúng. Nó cung cấp cho vấn đề đó trong Excel 2010/Win8.

Hãy thử điều này. Sử dụng mã tùy chỉnh Wait mà tôi đã viết. (Tested trong 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 

Alternative

Sử dụng Doevents cũng có tác dụng như mong muốn.

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