Sub CopyText(Text As String)
'VBA Macro using late binding to copy text to clipboard.
'By Justin Kay, 8/15/2014
Dim MSForms_DataObject As Object
Set MSForms_DataObject = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
MSForms_DataObject.SetText Text
MSForms_DataObject.PutInClipboard
Set MSForms_DataObject = Nothing
End Sub
用法:
Sub CopySelection()
CopyText Selection.Text
End Sub
Function Clipboard$(Optional s$)
Dim v: v = s 'Cast to variant for 64-bit VBA support
With CreateObject("htmlfile")
With .parentWindow.clipboardData
Select Case True
Case Len(s): .setData "text", v
Case Else: Clipboard = .getData("text")
End Select
End With
End With
End Function
'Three examples of copying text to the clipboard:
Clipboard "Excel Hero was here."
Clipboard var1 & vbLF & var2
Clipboard 123
'To read text from the clipboard:
MsgBox Clipboard
Private Sub CommandButton1_Click()
ClipBoard_SetData ("http:\\stackoverflow.com")
End Sub
将新模块添加到工作簿中,并粘贴以下代码:
Option Explicit
Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) _
As Long
Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) _
As Long
Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, _
ByVal dwBytes As Long) As Long
Declare Function CloseClipboard Lib "User32" () As Long
Declare Function OpenClipboard Lib "User32" (ByVal hwnd As Long) _
As Long
Declare Function EmptyClipboard Lib "User32" () As Long
Declare Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, _
ByVal lpString2 As Any) As Long
Declare Function SetClipboardData Lib "User32" (ByVal wFormat _
As Long, ByVal hMem As Long) As Long
Public Const GHND = &H42
Public Const CF_TEXT = 1
Public Const MAXSIZE = 4096
Function ClipBoard_SetData(MyString As String)
Dim hGlobalMemory As Long, lpGlobalMemory As Long
Dim hClipMemory As Long, X As Long
' Allocate moveable global memory.
'-------------------------------------------
hGlobalMemory = GlobalAlloc(GHND, Len(MyString) + 1)
' Lock the block to get a far pointer
' to this memory.
lpGlobalMemory = GlobalLock(hGlobalMemory)
' Copy the string to this global memory.
lpGlobalMemory = lstrcpy(lpGlobalMemory, MyString)
' Unlock the memory.
If GlobalUnlock(hGlobalMemory) <> 0 Then
MsgBox "Could not unlock memory location. Copy aborted."
GoTo OutOfHere2
End If
' Open the Clipboard to copy data to.
If OpenClipboard(0&) = 0 Then
MsgBox "Could not open the Clipboard. Copy aborted."
Exit Function
End If
' Clear the Clipboard.
X = EmptyClipboard()
' Copy the data to the Clipboard.
hClipMemory = SetClipboardData(CF_TEXT, hGlobalMemory)
OutOfHere2:
If CloseClipboard() = 0 Then
MsgBox "Could not close Clipboard."
End If
End Function
添加对Microsoft Forms 2.0对象库的引用,然后尝试使用此代码。它只适用于文本,不适用于其他数据类型。
Dim DataObj As New MSForms.DataObject
'Put a string in the clipboard
DataObj.SetText "Hello!"
DataObj.PutInClipboard
'Get a string from the clipboard
DataObj.GetFromClipboard
Debug.Print DataObj.GetText
Option Explicit
Private Declare Function OpenClipboard Lib "user32.dll" (ByVal hWnd As Long) As Long
Private Declare Function EmptyClipboard Lib "user32.dll" () As Long
Private Declare Function CloseClipboard Lib "user32.dll" () As Long
Private Declare Function IsClipboardFormatAvailable Lib "user32.dll" (ByVal wFormat As Long) As Long
Private Declare Function GetClipboardData Lib "user32.dll" (ByVal wFormat As Long) As Long
Private Declare Function SetClipboardData Lib "user32.dll" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Private Declare Function GlobalAlloc Lib "kernel32.dll" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalLock Lib "kernel32.dll" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32.dll" (ByVal hMem As Long) As Long
Private Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function lstrcpy Lib "kernel32.dll" Alias "lstrcpyW" (ByVal lpString1 As Long, ByVal lpString2 As Long) As Long
Public Sub SetClipboard(sUniText As String)
Dim iStrPtr As Long
Dim iLen As Long
Dim iLock As Long
Const GMEM_MOVEABLE As Long = &H2
Const GMEM_ZEROINIT As Long = &H40
Const CF_UNICODETEXT As Long = &HD
OpenClipboard 0&
EmptyClipboard
iLen = LenB(sUniText) + 2&
iStrPtr = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, iLen)
iLock = GlobalLock(iStrPtr)
lstrcpy iLock, StrPtr(sUniText)
GlobalUnlock iStrPtr
SetClipboardData CF_UNICODETEXT, iStrPtr
CloseClipboard
End Sub
Public Function GetClipboard() As String
Dim iStrPtr As Long
Dim iLen As Long
Dim iLock As Long
Dim sUniText As String
Const CF_UNICODETEXT As Long = 13&
OpenClipboard 0&
If IsClipboardFormatAvailable(CF_UNICODETEXT) Then
iStrPtr = GetClipboardData(CF_UNICODETEXT)
If iStrPtr Then
iLock = GlobalLock(iStrPtr)
iLen = GlobalSize(iStrPtr)
sUniText = String$(iLen \ 2& - 1&, vbNullChar)
lstrcpy StrPtr(sUniText), iLock
GlobalUnlock iStrPtr
End If
GetClipboard = sUniText
End If
CloseClipboard
End Function
可以从自定义宏调用上述代码,如下所示:
Sub TestClipboard()
Dim Val1 As String: Val1 = "Hello Clipboard " & vbLf & "World!"
SetClipboard Val1
MsgBox GetClipboard
End Sub
9条答案
按热度按时间smdncfj31#
MSForms已经过时了,所以你不应该再使用我的答案,而应该使用下面的答案:https://stackoverflow.com/a/60896244/692098
我把原来的答案留在这里,只供参考:
用法:
yfjy0ee72#
要将文本写入Windows剪贴板(或从中读取文本),请使用以下VBA函数:
此解决方案既不使用MS Forms,也不使用Win32 API。相反,它使用Microsoft HTML对象库,该对象库速度快、无处不在,并且不像MS Forms那样被Microsoft弃用。此解决方案支持换行符。此解决方案也适用于64位Office。最后,此解决方案允许写入Windows剪贴板和从Windows剪贴板读取。此页上的其他解决方案都没有这些优点。
qyuhtwio3#
最简单(非Win32)的方法是将UserForm添加到VBA项目(如果您还没有),或者添加对 Microsoft Forms 2 Object Library 的引用,然后您可以从工作表/模块简单地执行以下操作:
gc0ot86w4#
如果url位于工作簿的单元格中,则只需从该单元格复制值即可:
(Add按钮。如果功能区不可见,请自定义功能区。)
如果URL不在工作簿中,则可以使用Windows API。以下代码可在此处找到:http://support.microsoft.com/kb/210216
添加下面的API调用后,更改按钮背后的代码以复制到剪贴板:
将新模块添加到工作簿中,并粘贴以下代码:
t1qtbnec5#
添加对Microsoft Forms 2.0对象库的引用,然后尝试使用此代码。它只适用于文本,不适用于其他数据类型。
Here您可以找到有关如何将剪贴板与VBA一起使用的详细信息。
6tr1vspr6#
如果要使用“即时”窗口将变量的值放入剪贴板中,可以使用下面这一行轻松地在代码中放置断点:
zrfyljdw7#
如果你要粘贴的地方没有粘贴表格格式的问题(如浏览器URL栏),我认为最简单的方法是这样的:
r8xiu3jd8#
微软网站上给出的代码也可以在Excel中工作,尽管它是在Access VBA下。我在64位Windows 10上的Excel 365中试用过。
Microsoft站点链接:https://learn.microsoft.com/en-us/office/vba/access/Concepts/Windows-API/send-information-to-the-clipboard
复制此处以确保答案完整。
可以从自定义宏调用上述代码,如下所示:
若要在窗体上显示按钮,可以通过快速搜索找到一个很好的示例。若要在Excel自定义功能区(仅在当前Excel工作簿中显示)中显示按钮,可以使用CustomUI。
自定义UI链接:
https://bettersolutions.com/vba/ribbon/custom-ui-editor.htm
https://learn.microsoft.com/en-us/office/open-xml/how-to-add-custom-ui-to-a-spreadsheet-document
带图标的imageMSO列表(在CustomUI中使用):
https://bert-toolkit.com/imagemso-list.html
谢谢。
rdrgkggo9#
我在excel 365中测试了这段代码,它工作正常