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

Question

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

我对Excel VBA有一些了解，但已经有一段时间了，我感到困难重重。

- user1958738

---

欢迎来到stackoverflow！如果您能分享一下您已经尝试过的内容，那么您更有可能得到解决问题的帮助。 - Joe Day

Windows 10 x64和Office 2016 x64：https://dev59.com/XJTfa4cB1Zd3GeqPMBsY#42514269 - Marcin Rudzki

Answer 1

编辑 - MSForms已经过时，因此您不应再使用我的答案。请改为使用此答案：https://dev59.com/b2Yq5IYBdhLWcg3wwDRA#60896244

我仅在此处保留我的原始答案供参考：

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

- Jroonk

---

这对于无法完全通过spy看到的长查询非常有帮助。非常感谢！ - Lionel T.

虽然依赖于魔术字符串，但它非常有帮助，可以整洁地保存对第三方DLL等的额外引用。再加上1。 - jim tollan

这段代码存在一个漏洞，最终它将停止复制您的文本并且仅复制两个问号。 - cyberponk

@Jroonk，这种方法会失败（至少在Windows 10上是如此，其他Windows版本不确定），如果文件资源管理器打开到某个文件夹，则无法正常粘贴。根据粘贴目标的编码方式，可能会出现??或\xEF\xBF\xBF\xEF\xBF\xBF的情况。 - ChrisB

@SendETHToThisAddress，现在应该使用此答案将VBA复制到剪贴板：https://dev59.com/b2Yq5IYBdhLWcg3wwDRA#60896244。他正在做同样的事情，但是他使用htmlfile对象访问剪贴板，而不是已弃用的MSForms对象。 - Jroonk

Answer 2

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

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

这是一种不使用MS Forms或Win32 API的解决方案。相反，它使用微软HTML对象库，该库快速且普及度高，并且不像MS Forms那样被微软弃用。此解决方案还尊重换行符。此解决方案也适用于64位Office。最后，此解决方案允许同时写入和读取Windows剪贴板。本页面上没有其他解决方案具有这些优点。

- Excel Hero

---

解决“无效参数”问题的方法（适用于64位Excel 2010）：.setData的第二个参数必须是一种变体类型（像“test”这样的字符串文字也可以），而不是字符串类型的变量。创建一个Variante变量，将s赋值给它，然后在.setData中使用它，就可以正常工作了。 - Bill Dimm

@Shodan。$ 表示字符串。 - Excel Hero

@Shodan 这与以下代码完全相同：Function Clipboard() As String。 - Excel Hero

@Shodan 自从 VBA 甚至 Visual Basic 诞生之前，这种表示法就已经成为 BASIC 的本地表示法了。 - Excel Hero

@Timo 确实，这就是为什么我将这个解决方案描述为编写和读取文本的原因。 - Excel Hero

Answer 3

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

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

- Alex K.

---

这是我使用的方法，但我发现如果在Windows 10的文件资源管理器中打开一个文件夹，该方法将失败。我不能对其他Windows版本进行评论。 - ChrisB

哇，@ChrisB 真是太棒了，我已经试图解决那个问题多年了！ - Stack Man

MSForms已经被弃用，因此您不应再使用它。相反，请使用此答案：https://dev59.com/b2Yq5IYBdhLWcg3wwDRA#60896244 - Jroonk

Answer 4

如果URL在工作簿中的单元格中，您可以直接复制该单元格中的值：

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

通过使用开发者选项卡添加按钮。如果未显示选项卡，则自定义选项卡。

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

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

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

- Jon Crowell

---

从KB中可以看出，这段代码的目标是Access 2000。该代码可能旨在在不支持Unicode的旧操作系统上运行（Win95？）。不幸的是，我们仍在使用同一段无法处理扩展ASCII范围之外任何字符的代码，因此您无法使用Unicode！ - Renaud Bompuis

虽然它没有回答OP如何获取剪贴板中可能或可能不在单元格中的URL的问题，但是+1是为.Copy方法提供参考。嗯，有时最简单的答案是最好的！ - GlennFromIowa

这是我的新首选方法！当文件资源管理器打开到一个文件夹时，它不会失败。 - ChrisB

新的位置是：https://learn.microsoft.com/zh-cn/office/vba/access/concepts/windows-api/send-information-to-the-clipboard - Jroonk

第一种方法（Range.Copy）不会复制文本，而是单元格：Excel将在文本的开头和结尾添加引号（“），并用双引号替换引号。 - Martin Rosenau

Answer 5

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

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

- stenci

---

这段代码有个bug，最终它将停止复制你的文本，并只复制2个问号。 - cyberponk

MSForms已经被弃用，因此您不应再使用它。而是请使用这个答案：https://dev59.com/b2Yq5IYBdhLWcg3wwDRA#60896244 - Jroonk

Answer 6

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

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

- F_Face

---

这段代码有一个错误，最终它将停止复制您的文本并仅复制2个问号。 - cyberponk

Answer 7

我在Excel 365中测试了这段代码，它可以正常工作。

Dim str as String
str = "Hello Copied"
Windows.Parent.Clipboard str

注意：我创建了这个变量，因为代码无法处理字符串连接

- Wendel

Answer 8

如果你只想复制到剪贴板，你可以像这样总结答案https://dev59.com/b2Yq5IYBdhLWcg3wwDRA#60896244。

Sub copyClip()
   Dim yourtext As String
   yourtext = "abdc43"
   CreateObject("htmlfile").parentWindow.clipboardData.setData "text", yourtext
End Sub

- Rafael Cinoto

Answer 9

在Windows中使用cmd shell的简单方法。

Sub PutToClip()
    
    Dim txt As String: txt = "This works!"
    Call Shell("cmd.exe /k" & "echo " & txt & " | clip", vbHide)
    
End Sub

- Rayearth

Answer 10

如果你要粘贴的地方可以接受表格格式（比如浏览器的URL栏），我认为最简单的方法是这样的：

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

- Maycow Moura

---

请注意，这会“弄脏”工作簿。另一个问题是，如果有单元格或工作表保护，您可能需要费力地处理它们。没有这些问题的替代方法是使用workbooks.add、cells(1)=string、cells(1).copy，并在关闭时设置SaveChanges:=False。 - MicrosoftShouldBeKickedInNuts