logo标签列表

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

excelclipboardvba
67

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

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

2
欢迎来到stackoverflow！如果您能分享一下您已经尝试过的内容，那么您更有可能得到解决问题的帮助。 - Joe Day
1
Windows 10 x64和Office 2016 x64：https://dev59.com/XJTfa4cB1Zd3GeqPMBsY#42514269 - Marcin Rudzki
11个回答
-1
在微软网站上提供的代码也可以在Excel中使用，即使它是在Access VBA下编写的。我在64位Windows 10上的Excel 365中尝试过了。
微软网站链接: https://learn.microsoft.com/en-us/office/vba/access/Concepts/Windows-API/send-information-to-the-clipboard 这里复制以保证答案完整。
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

要在表单上显示一个按钮，你可以通过快速搜索找到一个很好的例子。要在Excel自定义功能区中显示一个按钮（仅在当前Excel工作簿中显示），你可以使用CustomUI。
CustomUI链接：

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列表（用于自定义UI）：

https://bert-toolkit.com/imagemso-list.html

谢谢。

网页内容由stack overflow 提供, 点击上面的
可以查看英文原文，
原文链接