2009-07-10 6 views
4

さまざまなソースからのデータをExcelに貼り付ける際に重大な問題がありました。 Excelはスマートにしようとする傾向があり、あらゆる種類の愚かなformatingを行います。データはテキストとして必要です。Excel VBAマクロ:貼り付ける前にクリップボードの内容を確認してください

私たちは多くのユーザーを抱えていますが、その多くはコンピュータに慣れていないため、右クリックして「毎回ペースト」を使用するように求めています。

「ペースト・スペシャル」と「テキスト」を使用するマクロを記録し、この機能を使用するためにctrl-vをオーバーライドする方法を発見しました。私はセルにマーキングし、それをコピーし、それを貼り付けようとするまで、完全に動作するように見えました。マクロがクラッシュしました。

だから私は必要なものを私はいくつかコピーしたテキストをペーストしようとしていますかどうかを確認してから、このラインを使用することができます機能です:私はマークされたセルを貼り付けていた場合、私が実行したいものの

ActiveSheet.PasteSpecial Format:="Text", Link:=False, DisplayAsIcon:= _ 
     False 

をこの行(値だけを貼り付ける):

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
     :=False, Transpose:=False 

私は非常に(と私は私がする必要はありません願っています)Excel用VBAマクロを書面で経験したわけではないので、誰もがいくつかのポインタを持っている場合、私は思います最も感謝しています。

答えて

3

クリップボードへのアクセス/操作については、Microsoft®Forms 2.0ライブラリへの参照をProject-> Referencesに追加することをお勧めします。次に、GetFormatメソッドを持つクラスを使用して、クリップボードに特定の種類のデータがあるかどうかを確認できます。

Thisは、DataObjectを使用したクリップボード処理のかなりのイントロです。

+0

マイExcel2013 Win7の上(64)(64)は、Microsoftが2.0ライブラリフォームは表示されませんでした。私はツール/リファレンス/ブラウズ...を選択し、c:/windows/system32/FM20.DLLファイルを選択しなければなりませんでした。その後、データオブジェクト型を使用することができました。 – Whome

0

ターゲットシートのセルをテキストと同じにすると考えましたか?彼らが将軍であるとき、Excelはあなたが見たいと思うところで最高の推測です。一方

あなたは本当に特別な貼り付けを実装したい場合は...あなたがキャッチすることができない「貼り付け」のイベントが

ありません - あなたはペーストが発生する可能性があるすべての場所をキャッチしています。ワークブックは(のWorkbook_Open)を起動したときに、次のコードを発行する場合

たとえば、あなたは、CTRL-Vのキー入力をキャプチャすることができます。

Application.OnKey "^v", "DoMyPaste" 

これは、Excelのペースト機能の代わりに、あなたの関数を呼び出します。モジュールにはこのようなものを置く:

Public Sub DoMyPaste() 
    If Selection.[is marked cell] Then 
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
     :=False, Transpose:=False 
    Else 
     ActiveSheet.PasteSpecial Format:="Text", Link:=False, DisplayAsIcon _ 
     := False 
    End If 
End Sub 

私はこれをテストしていませんが、これはラフスケッチの詳細です。 Selectionは2つ以上のセルになる可能性があるので、 "マークされたセルをチェックする"は何らかの方法で範囲全体をチェックする必要があります。

これはちょうど氷山の先端です。これが最大の解決策ではありません

http://www.jkp-ads.com/Articles/CatchPaste.asp 
0

が、それは技術的に動作します:あなたは完全なソリューションにしたい場合は、すべての貼り付けのコールを引くのOCDのバージョンであるこの記事をチェックアウトする必要があります。 両方を試してみてください。

On Error Resume Next 
ActiveSheet.PasteSpecial Format:=Text, Link:=False, DisplayAsIcon:=False 
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 
1
Sub PasteAsText() ' Assign Keyboard Shortcut: Ctrl+v 
    Application.ScreenUpdating = False 
    Select Case Application.CutCopyMode 
     Case Is = False 
       On Error Resume Next 
       ActiveSheet.PasteSpecial Format:="Text", Link:=False, DisplayAsIcon:=False 
     Case Is = xlCopy 
      If Not Range(GetClipboardRange).HasFormula Then 
       Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 
      Else 
       ActiveSheet.Paste 
      End If 
     Case Is = xlCut 
      ActiveSheet.Paste 
    End Select 
    Application.CutCopyMode = False 
    Application.ScreenUpdating = True 
End Sub 

Function GetClipboardRange() As String 
    ' Edited from http://www.ozgrid.com/forum/showthread.php?t=66773 
    Dim formats 'Check to make sure clipboard contains table data 
    formats = Application.ClipboardFormats 
    For Each fmt In formats 
     If fmt = xlClipboardFormatCSV Then 
      Application.ActiveSheet.Paste Link:=True 'Paste link 

      Dim addr1, addr2 As String 'Parse formulas from selection 

      addr1 = Application.Substitute(Selection.Cells(1, 1).Formula, "=", "") 
      addr2 = Application.Substitute(Selection.Cells(Selection.Rows.Count, Selection.Columns.Count).Formula, "=", "") 

      GetClipboardRange = addr1 & IIf(addr1 <> addr2, ":" & addr2, "") 
      Exit For 
     End If 
    Next 
End Function 
関連する問題