将特定字符串复制到剪贴板的 Excel VBA 代码

Excel VBA code to copy a specific string to clipboard

提问by user1958738

I'm trying to add a button to a spreadsheet that when clicked will copy a specific URL to my clipboard.

我正在尝试向电子表格添加一个按钮，单击该按钮会将特定 URL 复制到我的剪贴板。

I had a bit of knowledge of Excel VBA but it's been a while and I'm struggling.

我对 Excel VBA 有一些了解，但已经有一段时间了，我很挣扎。

回答by Jroonk

This macro uses late binding to copy text to the clipboard without requiring you to set references. You should be able to just paste and go:

此宏使用后期绑定将文本复制到剪贴板，而无需您设置引用。您应该能够粘贴并运行：

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

Usage:

用法：

Sub CopySelection()
    CopyText Selection.Text
End Sub

回答by Alex K.

The simplest (Non Win32) way is to add a UserForm to your VBA project (if you don't already have one) or alternatively add a reference to Microsoft Forms 2 Object Library, then from a sheet/module you can simply:

最简单的（非 Win32）方法是将用户窗体添加到您的 VBA 项目（如果您还没有）或添加对Microsoft Forms 2 Object Library的引用，然后从工作表/模块中，您可以简单地：

With New MSForms.DataObject
    .SetText "http://zombo.com"
    .PutInClipboard
End With

回答by Jon Crowell

If the url is in a cell in your workbook, you can simply copy the value from that cell:

如果 url 在您的工作簿中的单元格中，您可以简单地从该单元格复制值：

Private Sub CommandButton1_Click()
    Sheets("Sheet1").Range("A1").Copy
End Sub

(Add a button by using the developer tab. Customize the ribbon if it isn't visible.)

（使用开发人员选项卡添加按钮。如果功能区不可见，请自定义功能区。）

If the url isn't in the workbook, you can use the Windows API. The code that follows can be found here: http://support.microsoft.com/kb/210216

如果 url 不在工作簿中，您可以使用 Windows API。下面的代码可以在这里找到：http: //support.microsoft.com/kb/210216

After you've added the API calls below, change the code behind the button to copy to the clipboard:

添加下面的 API 调用后，更改按钮后面的代码以复制到剪贴板：

Private Sub CommandButton1_Click()
    ClipBoard_SetData ("http:\stackoverflow.com")
End Sub

Add a new module to your workbook and paste in the following code:

将新模块添加到您的工作簿并粘贴以下代码：

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

回答by stenci

Add a reference to the Microsoft Forms 2.0 Object Library and try this code. It only works with text, not with other data types.

添加对 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

Hereyou can find more details about how to use the clipboard with VBA.

在这里您可以找到有关如何在 VBA 中使用剪贴板的更多详细信息。

回答by F_Face

If you want to put a variable's value in the clipboard using the Immediate window, you can use this single line to easily put a breakpoint in your code:

如果您想使用立即窗口将变量的值放入剪贴板，您可以使用这一行轻松地在您的代码中放置一个断点：

Set MSForms_DataObject = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}"): MSForms_DataObject.SetText VARIABLENAME: MSForms_DataObject.PutInClipboard: Set MSForms_DataObject = Nothing

回答by Maycow Moura

If the place you're gonna paste have no problem with pasting a table formating (like the browser URL bar), I think the easiest way is this:

如果您要粘贴的地方粘贴表格格式（如浏览器 URL 栏）没有问题，我认为最简单的方法是：

Sheets(1).Range("A1000").Value = string
Sheets(1).Range("A1000").Copy
MsgBox "Paste before closing this dialog."
Sheets(1).Range("A1000").Value = ""

回答by Excel Hero

To write text to (or read text from) the Windows clipboard use this VBA function:

要将文本写入（或从中读取）Windows 剪贴板，请使用此 VBA 函数：

Function Clipboard$(Optional s$)
    With CreateObject("htmlfile")
    With .parentWindow.clipboardData
        Select Case True
            Case Len(s): .setData "text", s
            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 [A1:Z999]

'To read text from the clipboard:
MsgBox Clipboard

This is a solution that does NOT use MS Forms nor the Win32 API. Instead it uses the Microsoft HTML Object Library which is fast and ubiquitous; and this solution respects line feeds.

这是一个不使用 MS Forms 和 Win32 API 的解决方案。相反，它使用了快速且无处不在的 Microsoft HTML 对象库；这个解决方案尊重换行符。