Excel VBA宏:检查粘贴前的内容(剪贴板?)
我在将各种数据源的数据粘贴到Excel中时遇到了一些严重的问题。 Excel往往会试图变得聪明,并会进行各种愚蠢的格式化。我们需要数据作为文本。Excel VBA宏:检查粘贴前的内容(剪贴板?)
问题是我们有很多用户,他们中的很多人对计算机不是很有经验,所以要求他们每次都使用右键单击和“选择性粘贴”不是一种选择。
我在录制使用'Paste Special'和'text'宏并重写ctrl-v以使用此函数的宏中找到了解决方案。它似乎完美地工作,直到我标记了一个单元格,复制它并试图粘贴它。宏坠毁。
所以我需要的是一个可以检查是否我想粘贴一些复制的文本,然后使用该行的函数:
ActiveSheet.PasteSpecial Format:="Text", Link:=False, DisplayAsIcon:= _
False
虽然如果我粘贴标记的单元,我想运行这条线(粘贴只值):
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
我不是很书面的VBA宏为Excel(我希望我永远也不会),因此,如果任何人有几个三分球经历,我会非常感谢。
对于剪贴板访问/操作,您需要在Project-> References中添加对Microsoft Forms 2.0库的引用。然后,您可以使用MSForms.DataObject
类(其中包含)GetFormat
方法来检查剪贴板是否具有特定类型的数据。
This是使用DataObject
进行剪贴板处理的不错介绍。
您是否考虑过让目标工作表中的单元格等于文本?当他们是General时,Excel是最好的 - 猜测你期望看到什么。
上,如果你真的想要实现选择性粘贴另一方面...
没有“粘贴”事件中,你能赶上 - 你必须赶上到可能发生糊的每一个地方。
例如,您可以捕获CTRL-V按键,如果你在工作簿启动(Workbook_Open)发出以下代码:
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
我还没有测试过这个,这是一个粗略的草图。请注意,选择可能不止一个单元格,因此您的“检查标记单元格”需要以某种方式检查整个范围。
虽然这只是冰山一角。如果你想一个完整的解决方案,你应该看看这篇文章,这是捕获所有粘贴通话的OCD版本:
http://www.jkp-ads.com/Articles/CatchPaste.asp
这是不是最好的解决方案,但它在技术上的作品。 只需尝试一下。
On Error Resume Next
ActiveSheet.PasteSpecial Format:=Text, Link:=False, DisplayAsIcon:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
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
我Excel2013 Win7上(64)(64位)没有列出Microsoft窗体2.0库。我必须选择工具/参考/浏览...并选择c:/windows/system32/FM20.DLL文件。然后才能够使用数据对象类型。 – Whome 2014-09-10 09:39:52