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

Question

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

我对Excel VBA有一点了解,但已经有一段时间了,我正在努力.

Answer 1

此宏使用后期绑定将文本复制到剪贴板,而无需您设置引用.你应该可以粘贴并去:

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

Answer 2

最简单的(Non Win32)方法是将一个UserForm添加到您的VBA项目中(如果您还没有)或者添加对Microsoft Forms 2对象库的引用,然后从工作表/模块中您可以简单地:

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

Answer 3

要将文本写入（或从中读取）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 的解决方案。相反，它使用 Microsoft HTML 对象库，该库快速且无处不在，并且没有像 MS Forms 那样被 Microsoft 弃用。这个解决方案尊重换行符。此解决方案也适用于 64 位 Office。最后，此解决方案允许写入和读取 Windows 剪贴板。此页面上没有其他解决方案具有这些优势。

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

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剪贴板的更多详细信息.

Answer 6

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

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