Visual Basic for Applications/剪貼簿 VBA

摘要

主要有三種方法可以使用 VBA 程式碼將文字傳遞到剪貼簿和從剪貼簿中獲取文字。

DataObject 方法
- 這可能是最簡單的實現。.
- 其主要限制是，當啟動應用程式關閉時，剪貼簿內容將丟失；通常在執行 Excel 模組時這不是問題，但應牢記這一點。
- 一些其他使用者報告了錯誤。有關錯誤和一個建議的修復程式的詳細資訊，請參閱 DataObject 錯誤論壇。此頁面上的所有過程都在 Windows 7 和 Windows 8.1 中針對 Excel 2010 進行了測試，並且執行良好。DataObject 方法最近已在該系列中針對 VBA 縮排模組採用。
- 其他方法避免了這些限制。如果這些過程出現問題（這種情況不太可能發生），則可以使用接下來的兩種方法中的任何一種。
- DataObject 方法示例在該頁面的第二部分給出。
使用者窗體控制元件方法
- 當需要顯示使用者窗體時，可以使用文字框的複製和貼上方法。這些方法執行良好，並且經過良好測試。
- 當不需要顯示使用者窗體時，可以使用隱藏窗體。載入帶有文字框的窗體，但不顯示它。然後，仍然可以像正常一樣對不可見的使用者窗體的控制元件進行編碼。對於大多數有用的文字傳輸，文字框必須將其Multiline 屬性設定為true。通常最好將窗體的ShowModal 屬性設定為False；這允許方便地進行程式碼跟蹤，並避免許多其他混亂。
- 隱藏使用者窗體方法示例在第四部分給出。第三部分中另一個可見使用者窗體示例顯示瞭如何在複製之前跟蹤活動文字框。
API 方法
- 這些方法使用 Windows 庫，並且在其模組標題中具有大量的宣告。也就是說，它們執行良好，並且在 Microsoft 文件中被描述為最合適的。
- API 使用示例在第五部分顯示。有關更多詳細資訊，請參閱 將資訊傳送到剪貼簿。

DataObject 方法

這些方法使用DataObject。它們是迄今為止最靈活的方法，因為可以放在變數中的任何文字都可以使用PutInClipboard 方法放在剪貼簿上。還可以使用GetFromClipboard 方法將文字帶入 VBA 字串變數中。下面的示例中的CopyToClip() 和GetFromClip() 過程首先將文字傳送到剪貼簿，然後再次獲取它，然後在訊息框中顯示文字。為此，在編輯器選項中設定對Microsoft Forms 2 的引用；如果找不到它，只需將使用者窗體新增到您的專案中，它就會被新增到選擇中。
在其他地方報告了 DataObject 方法中的錯誤。這些適用於 Win 7 以外的 Windows 版本，據報道涉及物件和剪貼簿之間不尋常的永續性。如果發現這些方法存在困難，則可以嘗試虛擬使用者窗體方法或 API 方法。

Sub testCopyAndPaste()
    'demonstrates copy and paste of text to variables
    'loads clipboard with date-time text then
    'fetches it back for display
    'Only good for text and clipboard content lost
    'when application closes.
        
    Dim sStrOut As String, sStrIn As String
    
    'get the current date-time string
    sStrOut = Now
    
    'copy text to clipboard
    CopyToClip sStrOut

    'retrieve from clipboard
    sStrIn = GetFromClip
    
    'display recovered text
    MsgBox sStrIn

End Sub

Function CopyToClip(sIn As String) As Boolean
    'passes the parameter string to the clipboard
    'set reference to Microsoft Forms 2.0 Object Library.
    'If ref not listed, inserting user form will list it.
    'Clipboard cleared when launch application closes.
    
    Dim DataOut As DataObject
    
    Set DataOut = New DataObject
    
    'first pass textbox text to dataobject
    DataOut.SetText sIn
    
    'then pass dataobject text to clipboard
    DataOut.PutInClipboard
    
    'release object variable
    Set DataOut = Nothing
    
    CopyToClip = True
    
End Function

Function GetFromClip() As String
    'passes clipboard text to function name
    'If clipboard not text, an error results
    'set reference to Microsoft Forms 2.0 Object Library.
    'If ref not listed, inserting user form will list it.
    'Clipboard cleared when launch application closes.
    
    Dim DataIn As DataObject
    
    Set DataIn = New DataObject
    
    'clipboard text to dataobject
    DataIn.GetFromClipboard
    
    'dataobject text to function string
    GetFromClip = DataIn.GetText
    
    'release object variable
    Set DataIn = Nothing
    
End Function

可見使用者窗體方法

下面的程式碼模組提供了窗體模組的 VBA 程式碼（此處顯示為 UserForm1）。其中包含文字框Copy 和Paste 的命令按鈕單擊例程。要使用複製過程，使用者只需選擇一些文字，然後按使用者窗體上的按鈕即可。要將剪貼簿的內容貼上到文字框中，使用者必須首先將插入點放在文字框中的某處，然後按所需的按鈕。

為了澄清哪個文字框處於活動狀態，每個文字框都有一個滑鼠向上事件，每當在框中使用滑鼠時，就會將一個數字載入到模組級變數中。儘管此程式碼是為三個文字框編寫的，但它可以輕鬆地擴充套件到任意數量。

該程式碼假設有一個使用者窗體 UserForm1，其中包含 TextBox1、TextBox2、TextBox3、CommandButton1 和 CommandButton2。此外，請注意程式碼中有一個模組級變數。由於 VBA 程式碼是通用的，因此它適用於大多數 MS Office 應用程式。

Option Explicit
Dim nActTxtBx As Integer

Private Sub CommandButton1_Click()
'this is the "Paste at Cursor" button
'pastes clipboard active textbox's insertion point
'ie; the textbox last clicked with mouse
            
    Dim oTxt1 As Control, oTxt2 As Control, oTxt3 As Control
    Dim oFrm As UserForm, oTxt As Control, s As Long
    
    Set oFrm = UserForm1
    Set oTxt1 = oFrm.TextBox1
    Set oTxt2 = oFrm.TextBox2
    Set oTxt3 = oFrm.TextBox3
    
    'get the textbox with the focus
    Select Case nActTxtBx
    Case 0
        MsgBox "Please place the insertion point."
        Exit Sub
    Case 1
        Set oTxt = oTxt1
    Case 2
        Set oTxt = oTxt2
    Case 3
        Set oTxt = oTxt3
    Case Else
        Exit Sub
    End Select
    
    s = oTxt.SelStart
    With oTxt
        .Paste
        .SetFocus
        .SelStart = s
    End With

    Set oFrm = Nothing: Set oTxt = Nothing
    Set oTxt1 = Nothing: Set oTxt2 = Nothing
    Set oTxt3 = Nothing
End Sub

Private Sub CommandButton2_Click()
'this is the "Copy Selected Text" button
'copies selected text from textbox to clipboard
'ie; the textbox last clicked with mouse

    Dim oTxt1 As Control, oTxt2 As Control, oTxt3 As Control
    Dim oFrm As UserForm, oTxt As Control
    
    Set oFrm = UserForm1
    Set oTxt1 = oFrm.TextBox1
    Set oTxt2 = oFrm.TextBox2
    Set oTxt3 = oFrm.TextBox3
    
    'get reference to active textbox
    Select Case nActTxtBx
    Case 0
        MsgBox "Please make a selection."
        Exit Sub
    Case 1
        Set oTxt = oTxt1
    Case 2
        Set oTxt = oTxt2
    Case 3
        Set oTxt = oTxt3
    Case Else
        Exit Sub
    End Select
    
    'check that a selection was made
    'MsgBox oTxt.SelLength
    If oTxt.SelLength = 0 Then
        MsgBox "No selection found."
        Exit Sub
    End If
    
    With oTxt
        .Copy
        .SetFocus
        .SelStart = 0
    End With

    Set oFrm = Nothing: Set oTxt = Nothing
    Set oTxt1 = Nothing: Set oTxt2 = Nothing
    Set oTxt3 = Nothing

End Sub

Private Sub TextBox1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, _
                                ByVal X As Single, ByVal Y As Single)
    'loads an integer to denote active textbox when mouse makes selection
    nActTxtBx = 1
End Sub

Private Sub TextBox2_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, _
                                ByVal X As Single, ByVal Y As Single)
    'loads an integer to denote active textbox when mouse makes selection
    nActTxtBx = 2
End Sub

Private Sub TextBox3_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, _
                                ByVal X As Single, ByVal Y As Single)
    'loads an integer to denote active textbox when mouse makes selection
    nActTxtBx = 3
End Sub

隱藏使用者窗體方法

此程式碼應放在標準模組中。該專案需要一個名為Temp 的使用者窗體，其中包含一個設定為 MultiLine=true 的 TextBox1。文字框內容始終為文字。

Option Explicit

Sub TestClipboardProcs()
'run this
    
    CopyToClipboard "The string" & vbCrLf & _
                    "to copy..."
    MsgBox GetClipboard2

End Sub

Function GetClipboard2() As String
'PASTES clipboard into function name as a text string
'project needs userform named Temp
'with TextBox1 in it set with property Multiline=true
    
    Dim oTxt1 As Control, oFrm As UserForm
    Dim s As Long
    
    'load the temporary form
    Load Temp
    
    Set oFrm = Temp
    Set oTxt1 = oFrm.TextBox1
        
    s = oTxt1.SelStart
    With oTxt1
        .Paste
        .SetFocus
        .SelStart = s
    End With
    
    GetClipboard2 = oTxt1.Value
        
    Set oTxt1 = Nothing
    Set oFrm = Nothing
    Unload Temp

End Function

Function CopyToClipboard(sStr As String) As Boolean
'COPIES parameter variable text string value to clipboard
'project needs userform named Temp
'with TextBox1 in it set with property Multiline=true
    
    Dim oTxt1 As Control, oFrm As UserForm
    
    If sStr = "" Then
        MsgBox "Clipboard cannot hold an empty string."
        Exit Function
    End If
        
    'load the temporary form
    Load Temp
    
    Set oFrm = Temp
    Set oTxt1 = oFrm.TextBox1
    
    oTxt1.Value = sStr
        
    'copy textbox value to clipboard
    With oTxt1
        .SelStart = 0 'set up the selection
        .SelLength = .TextLength
        .Copy
        .SetFocus
        .SelStart = 0
    End With
        
    Set oTxt1 = Nothing
    Set oFrm = Nothing
    Unload Temp

    CopyToClipboard = True

End Function

API 方法

下面的程式碼是在 Excel 的 Office 2010 版本（32 位系統）上測試的，並且執行良好。從那時起，在 64 位 2019 Excel 中，該程式碼無法在其當前狀態下執行，而是需要針對 64 位使用進行進一步更改。

以下 VBA 程式碼使用 API 呼叫，並由 Microsoft 在其 MS Access 頁面 將資訊傳送到剪貼簿 中推薦。此類方法應克服 Windows 8 和 10 中DataObject 方法的當前錯誤。該程式碼應完整地複製到標準模組中。

Option Explicit
'Declarations for functions SetClipboard() and GetClipboard()
''from https://docs.microsoft.com/en-us/office/vba/access/concepts/windows-api/send-information-to-the-clipboard
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

Sub TestCopyPasteAPI()
    'API methods for clipboard
    Dim sIn As String, sOut As String
    
    sIn = "Sausages"
    SetClipboard sIn
    sOut = GetClipboard
    MsgBox sOut

End Sub

Public Sub SetClipboard(sUniText As String)
    'sets the clipboard with parameter string
      
    Dim iStrPtr As Long, 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
    'gets the clipboard text in function name
    
    Dim iStrPtr As Long, iLen As Long
    Dim iLock As Long, 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

另請參閱

將資訊傳送到剪貼簿：Microsoft 的一篇措辭清晰的頁面，展示瞭如何使用 API 方法訪問剪貼簿。雖然針對 MS Access 描述，但在 MS Excel 中同樣有效。
DataObject 錯誤論壇：Win7 以外的 Windows 版本中 DataObject 錯誤的描述。