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


Excel VBA code to copy a specific string to clipboard

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

我对Excel VBA有所了解，但是已经有一段时间了，我一直在努力。

相关讨论

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

1
2
3
4
5
6
7
8
9
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

用法：

1
2
3
Sub CopySelection()
    CopyText Selection.Text
End Sub
相关讨论

最简单的方法(非Win32)是将UserForm添加到您的VBA项目中(如果您还没有)，或者添加对Microsoft Forms 2对象库的引用，然后可以从工作表/模块中简单地进行以下操作：

1
2
3
4
With New MSForms.DataObject
    .SetText"http://zombo.com"
    .PutInClipboard
End With
相关讨论

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

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

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

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

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

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

在您的工作簿中添加一个新模块，并粘贴以下代码：

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
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对象库的引用，然后尝试使用此代码。它仅适用于文本，不适用于其他数据类型。

1
2
3
4
5
6
7
8
9
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中使用剪贴板的更多详细信息。

相关讨论

如果要使用"即时"窗口在剪贴板中放置变量的值，则可以使用以下单行轻松在代码中放置断点：

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

如果您要粘贴的位置粘贴表格格式(例如浏览器URL栏)没有问题，我认为最简单的方法是：

1
2
3
4
Sheets(1).Range("A1000").Value = string
Sheets(1).Range("A1000").Copy
MsgBox"Paste before closing this dialog."
Sheets(1).Range("A1000").Value =""
相关讨论