如何捕獲VBA中所有工作表的粘貼事件？

Question

有人可以幫我用下面的代碼我試圖捕獲粘貼事件來獲取粘貼的選擇，以刪除空間和非打印字符。所以基本上，當我粘貼時，我需要它自動檢查是否粘貼並從粘貼選擇中刪除任何空格和不可打印的字符，這將減少我的宏將處理的時間，因爲在給定時間將粘貼幾行並且它對我來說，在這種狀態下刪除空格和非打印字符似乎合乎邏輯，而列表很小，不會造成太多延遲。它撞在我身上，無法繞過它。

一如既往的任何幫助將不勝感激。

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) 
    Dim lastAction As String 
    'On Error Resume Next 
    ' Get the last action performed by user 
    lastAction = Application.CommandBars("Standard").Controls("&Undo") 
Debug.Print lastAction 
    ' Check if the last action was a paste 
    If Left(lastAction, 5) = "Paste" Then 

    Call removeSpace 
    End If 

End Sub 

Private Sub removeSpace() 
Dim rngremovespace As Range 
Dim CellChecker As Range 
Dim rng As Range 
'Set the range 
Set rngremovespace = Selection 
'Application.ScreenUpdating = False 
'This check to see if there are any non printing characters and replace them 
    rngremovespace.Select 
rngremovespace.Columns.Replace What:=Chr(160), Replacement:=Chr(32), _ 
    LookAt:=xlPart, SearchOrder:=xlByColumns, MatchCase:=False 

    'In case of any error skip 
On Error Resume Next 
'Looping through a range that is resizing 
    For Each CellChecker In rngremovespace.Columns 

    'This will clear all space in the cells 
    CellChecker.Value = Application.Trim(CellChecker.Value) 
    CellChecker.Value = Application.WorksheetFunction.Clean(CellChecker.Value) 

    'Looping to the next CellChecker 
    Next CellChecker 

    On Error GoTo 0 
    ' Application.ScreenUpdating = True 
Set rngremovespace = Nothing 
End Sub 

Answer 1

需要一個檢查，如果撤消列表爲空，禁用事件（未測試）循環細胞，而不是列，：

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) 
    With Application.CommandBars("Standard").Controls("&Undo") 
     If .ListCount < 1 Then Exit Sub 
     If .List(1) <> "Paste" Then Exit Sub    
    End With 

    Application.CutCopyMode = False 
    Application.EnableEvents = False 
    Selection.Replace ChrW(160), " ", xlPart 
    Dim cell As Range 
    For Each cell In Selection 
     cell.Value2 = WorksheetFunction.Trim(WorksheetFunction.Clean(cell.Value2))   
    Next 
    Application.EnableEvents = True 
End Sub