Vba excel копирование в буфер обмена

Update! Better Solution from ExcelHero

Excel MVP Daniel Ferry from ExcelHero graciously provided a much more eloquent solution than my original article over on the StackOverflow forum.

In the below solution, he is utilizing the Microsoft HTML Object Library to access the clipboard. This solution will work with 32-bit and 64-bit versions of Excel which has been a pain point for many proposed VBA solutions out there on the web. His VBA function also allows you to both read from the clipboard and write to the clipboard depending on if you pass through a variable. Check out this beautiful piece of code (and if you dare keep scrolling to see my original behemoth of a solution!).

Text To The Clipboard (original solution)

There may be instances where you create a macro that reads in text and sticks it in your computer’s clipboard so you can manually paste it somewhere else.  The most prominent way to do this, is to use a DataObject variable from the Forms library (language).

You can reference this library by either going to your Visual Basic Editor’s tools menu and enabling the Microsoft Forms 2.0 Object Library reference or by simply adding a userform to your project (the userform doesn’t have to do anything, it’s very existence tells your project that the Forms library is needed).

Below is a very self-explanatory snippet of VBA code that will show you how to copy text straight into your computer’s clipboard.

Sub CopyTextToClipboard()
‘PURPOSE: Copy a given text to the clipboard (using DataObject)
‘SOURCE: www.TheSpreadsheetGuru.com
‘NOTES: Must enable Forms Library: Checkmark Tools > References > Microsoft Forms 2.0 Object Library

Dim obj As New DataObject
Dim txt As String

‘Put some text inside a string variable
  txt = «This was copied to the clipboard using VBA!»

‘Make object’s text equal above string variable
  obj.SetText txt

‘Place DataObject’s text into the Clipboard
  obj.PutInClipboard

‘Notify User
  MsgBox «There is now text copied to your clipboard!», vbInformation

End Sub

There’s An Excel Office Bug!

I initially started investigating how to copy text to the clipboard while running someone else’s code.  This code worked perfectly on my work computer (using Windows 7/Excel 2007), however it kept copying just two question marks to the clipboard while executing the VBA code on my home computer (using Windows 8.1/Excel 2013).  It took me forever to narrow down what was causing this to happen (the source code was very long) and of course, the problem ended up being a bug on the part of Microsoft!

Luckily, there were many others who were running into this very issue on the forums.  Someone posted that they were actually able to troubleshoot this problem with a Microsoft support member a couple years ago (maybe in 2010) and that person determined it to be a bug.  The support member pointed to a solution using a Windows API as a workaround (shown in the next section).  

Copy To Clipboard With Windows API

Below is the API workaround suggested by Microsoft to get around the «SetText» bug.  It has three parts: an API declaration section, a Function routine, and then I used a similar subroutine macro to place the desired text into the Clipboard.

UPDATE: I have modified the API declarations to work with both 64-bit and 32-bit versions of Microsoft Office

‘Handle 64-bit and 32-bit Office
#If VBA7 Then
  Private Declare PtrSafe Function GlobalUnlock Lib «kernel32» (ByVal hMem As LongPtr) As LongPtr
  Private Declare PtrSafe Function GlobalLock Lib «kernel32» (ByVal hMem As LongPtr) As LongPtr
  Private Declare PtrSafe Function GlobalAlloc Lib «kernel32» (ByVal wFlags As LongPtr, _
    ByVal dwBytes As LongPtr) As LongPtr
  Private Declare PtrSafe Function CloseClipboard Lib «user32» () As LongPtr
  Private Declare PtrSafe Function OpenClipboard Lib «user32» (ByVal hwnd As LongPtr) As LongPtr
  Private Declare PtrSafe Function EmptyClipboard Lib «user32» () As LongPtr
  Private Declare PtrSafe Function lstrcpy Lib «kernel32» (ByVal lpString1 As Any, _
    ByVal lpString2 As Any) As LongPtr
  Private Declare PtrSafe Function SetClipboardData Lib «user32» (ByVal wFormat As LongPtr, _
    ByVal hMem As LongPtr) As LongPtr
#Else
  Private Declare Function GlobalUnlock Lib «kernel32» (ByVal hMem As Long) As Long
  Private Declare Function GlobalLock Lib «kernel32» (ByVal hMem As Long) As Long
  Private Declare Function GlobalAlloc Lib «kernel32» (ByVal wFlags As Long, _
    ByVal dwBytes As Long) As Long
  Private Declare Function CloseClipboard Lib «user32» () As Long
  Private Declare Function OpenClipboard Lib «user32» (ByVal hwnd As Long) As Long
  Private Declare Function EmptyClipboard Lib «user32» () As Long
  Private Declare Function lstrcpy Lib «kernel32» (ByVal lpString1 As Any, _
    ByVal lpString2 As Any) As Long
Private Declare Function SetClipboardData Lib «user32» (ByVal wFormat _
    As Long, ByVal hMem As Long) As Long
#End If

Const GHND = &H42
Const CF_TEXT = 1
Const MAXSIZE = 4096

Function ClipBoard_SetData(MyString As String)
‘PURPOSE: API function to copy text to clipboard
‘SOURCE: www.msdn.microsoft.com/en-us/library/office/ff192913.aspx

#If VBA7 Then
  Dim hGlobalMemory As LongPtr, lpGlobalMemory As LongPtr
  Dim hClipMemory As LongPtr, x As LongPtr
#Else
  Dim hGlobalMemory As Long, lpGlobalMemory As Long
  Dim hClipMemory As Long, x As Long
#End If

‘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

Sub CopyTextToClipboard()
‘PURPOSE: Copy a given text to the clipboard (using Windows API)
‘SOURCE: www.TheSpreadsheetGuru.com
‘NOTES: Must have above API declaration and ClipBoard_SetData function in your code

Dim txt As String

‘Put some text inside a string variable
  txt = «This was copied to the clipboard using VBA!»

‘Place text into the Clipboard
   ClipBoard_SetData txt

‘Notify User
  MsgBox «There is now text copied to your clipboard!», vbInformation

End Sub

About The Author

Hey there! I’m Chris and I run TheSpreadsheetGuru website in my spare time. By day, I’m actually a finance professional who relies on Microsoft Excel quite heavily in the corporate world. I love taking the things I learn in the “real world” and sharing them with everyone here on this site so that you too can become a spreadsheet guru at your company.

Through my years in the corporate world, I’ve been able to pick up on opportunities to make working with Excel better and have built a variety of Excel add-ins, from inserting tickmark symbols to automating copy/pasting from Excel to PowerPoint. If you’d like to keep up to date with the latest Excel news and directly get emailed the most meaningful Excel tips I’ve learned over the years, you can sign up for my free newsletters. I hope I was able to provide you with some value today and I hope to see you back here soon!

— Chris
Founder, TheSpreadsheetGuru.com

The code given at the Microsoft site works in Excel too, even though it is under Access VBA. I tried it in Excel 365 on a 64 bit Windows 10.

Microsoft Site Link: https://learn.microsoft.com/en-us/office/vba/access/Concepts/Windows-API/send-information-to-the-clipboard

Copying here for answer completeness.

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

The above code can be called from a Custom Macro as follows:

Sub TestClipboard()
    Dim Val1 As String: Val1 = "Hello Clipboard " & vbLf & "World!"
    SetClipboard Val1
    MsgBox GetClipboard
End Sub

To Show a button on a form, you can find a good example by a quick serach. To show a button in the Excel Custom Ribbon (One that shows only in the current Excel workbook) you can use CustomUI.

CustomUI links:

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 List with Icons (Used in CustomUI):

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

Thanks.