Excel VBA宏:在粘贴之前检查(剪贴板的内容?)内容

时间:2009-07-10 11:04:08

标签: excel vba copy-paste

将来自各种来源的数据粘贴到Excel中时遇到了一些严重问题。 Excel倾向于试图变得聪明并且做各种愚蠢的形成。我们需要数据作为文本。

问题是我们有很多用户,而且他们中的许多人对计算机不是很有经验,因此要求他们每次都使用右键单击和“选择性粘贴”不是一种选择。

我找到了一个录制宏的方法,该宏使用'Paste Special'和'text',并覆盖ctrl-v以使用此功能。它似乎工作得很好,直到我标记一个单元格,复制它,并试图粘贴它。宏崩溃了。

所以我需要的是一个可以检查我是否要尝试粘贴一些复制文本的函数,然后使用这一行:

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

如果我粘贴一个标记的单元格,我想运行此行(仅粘贴该值):

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

我在为Excel编写VBA宏方面不是很有经验(我希望我不必这样做),所以如果有人指点,我会非常感激。

4 个答案:

答案 0 :(得分:3)

对于剪贴板访问/操作,您需要在Project-> References中添加对Microsoft Forms 2.0库的引用。然后,您可以使用MSForms.DataObject类(以及其他)GetFormat方法来检查剪贴板是否具有特定类型的数据。

This是使用DataObject进行剪贴板处理的非常好的介绍。

答案 1 :(得分: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

答案 2 :(得分:0)

您是否考虑过让目标表中的单元格等于文本?当他们是General时,Excel会最好地猜测你期望看到的内容。

另一方面,如果你真的想实现Paste Special ...

没有“粘贴”事件可以捕获 - 您可以捕获每个可能发生粘贴的地方。

例如,如果在工作簿启动时发出以下代码(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可以是多个单元格,因此“检查标记单元格”需要以某种方式检查整个范围。

这只是冰山一角。如果你想要一个完整的解决方案,你应该查看这篇文章,这是捕获所有粘贴调用的OCD版本:

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

答案 3 :(得分:0)

这不是最好的解决方案,但它在技术上有效。 试试两个。

On Error Resume Next
ActiveSheet.PasteSpecial Format:=Text, Link:=False, DisplayAsIcon:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False