Excel VBAコードで値を強制的に貼り付けすると、オブジェクトを貼り付けるときに奇妙な動作が発生する

Question

ユーザーがさまざまな書式設定機能を上書きしないように、調査データを入力するスプレッドシートがあります。私は以下を使用しました：

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) 
On Error Resume Next 
Target.PasteSpecial xlPasteValues 
Application.CutCopyMode = True 
End Sub 

このコードは、セルをコピーまたは切断した後に値を強制的に適用するのに最適です。切り取ったりコピーしたりするときは、クリックした次のセルがペーストを受け取ります。Ctrl + Vを使うか右クリックしてペーストを選択する必要はありません。

しかし、オブジェクト（形状、挿入された画像など）をカットまたはコピーすると、最初のマウスクリック後に貼り付けが続行されることがテスト中に判明しました。後続のクリックごとに何度も何度も貼り付けられます。

私は誰がオブジェクトを貼り付ける際に奇妙な動作を修正するために、これを修正する方法を知ってい

をエクセル2010でこの動作を検証し、2013年？

Answer 1

貼り付け値メソッドのみを許可する場合は、以下のコードをMicrosoft ExcelオブジェクトThisWorkbook（つまり、どのモジュールにもない）の下に置きます。

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) 
    Dim UndoString As String, srce As Range 
    On Error GoTo err_handler 
    UndoString = Application.CommandBars("Standard").Controls("&Undo").List(1) 
    If Left(UndoString, 5) <> "Paste" And UndoString <> "Auto Fill" Then 
     Exit Sub 
    End If 
    Application.ScreenUpdating = False 
    Application.EnableEvents = False 
    Application.Undo 
    If UndoString = "Auto Fill" Then 
     Set srce = Selection 
     srce.Copy 
     Target.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 
     Application.SendKeys "{ESC}" 
     Union(Target, srce).Select 
    Else 
     Target.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 
    End If 
    Application.ScreenUpdating = True 
    Application.EnableEvents = True 
    Exit Sub 
err_handler: 
    Application.ScreenUpdating = True 
    Application.EnableEvents = True 
End Sub 

それは時間のほとんどをうまくいくものの、それも特に何もコピーされていないラップテキスト、等のような機能からなる外部コンテンツに時折起こることがあります。それは代わりに貼り付ける、値としてペーストを試みる（またはF2キー、次いでCtrlキー + Vを押す）をユーザに強制するように言われ、フォーマットを維持する目的が依然として維持されること

直接。

免責事項：このコードブロックはインターネットで広く使用されているため、私はこのクレームを認めません。