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