Questions similar to this appear on the Be Communities MicroStation Programming Forum.
Q As users of the world's most used operating system, we cut and paste every day. As computer users we are familiar with the Windows clipboard and therefore appreciate how it might in turn benefit the users of our programs.
If you've wondered how to use the clipboard in VBA you'll have run into one of those little hurdles Microsoft likes to put in our path: the clipboard is not included with VBA. MicroStation CONNECT delivered 64-bit VBA version 7.1. Unfortunately the relatively simple approach we were able to use with 32-bit VBA no longer works: we must make some calls to the Win32 API.
A VBA does not include a Clipboard object (even though pure Visual Basic does include one). This isn't some aberration of MicroStation VBA: it's missing from all VBA implementations because they are derived from the same Microsoft toolkit. However, the down-and-dirty Windows application programming interface (Win32 API) does include clipboard functions. As a VBA programmer your task is to figure out how to use the Win32 API to accomplish your goal.
This solution is more-or-less duplicated from code published by Karl E. Peterson, to whom full acknowledgement is given.
Because VBA doesn't provide a Clipboard
object, we create our own class that behaves programmatically in a similar fashion.
The guts of the class call the Win32 API directly, shielding the VBA caller from the ugly details.
Here's how you might use this class …
Function ClipboardAsDouble() As Double
ClipboardAsDouble = 0#
On Error GoTo err_ClipboardAsDouble
Dim oClipboard As New clsClipboard ' Our own clipboard class
ClipboardAsDouble = CDbl(oClipboard.GetText)
Debug.Print "Clipboard=" & CStr(CDbl(oClipboard.GetText))
Exit Function
err_ClipboardAsDouble:
MsgBox "Error no. " & CStr(Err.Number) & ": " & Err.Description, vbCritical Or vbOKOnly, "Error in ClipboardAsDouble"
End Function
Here's the clipboard class source code. To use this, first create a new VBA class module clsClipboard
,
then copy-and-paste this code into your new class.
Option Explicit' --------------------------------------------------------------------
Private Const sMODULE_NAME As String = "clsClipboard"' -------------------------------------------------------------------- ' VBA doesn't provide any method to get or set data in the Windows ' Clipboard. This class provides some basic methods for Clipboard ' operation. ' -------------------------------------------------------------------- ' Notice: ' This example code is provided as-is by LA Solutions Ltd with no ' warranty of fitness for purpose and with no support. This ' example is derived from published information found at this URL: ' http://vb.mvps.org/articles/ap200106.asp ' ' You are free to use and adapt this code for personal or commercial use ' provided that this notice is retained in full ' End of notice ' --------------------------------------------------------------------
' Clipboard Manager Functions' --------------------------------------------------------------------
Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As LongPtr) As Long Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long Private Declare PtrSafe Function EmptyClipboard Lib "user32" () As Long Private Declare PtrSafe Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As LongPtr) As LongPtr Private Declare PtrSafe Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As LongPtr Private Declare PtrSafe Function IsClipboardFormatAvailable Lib "user32" (ByVal wFormat As Long) As Long Private Declare PtrSafe Function GetPriorityClipboardFormat Lib "user32" (lpPriorityList As Long, ByVal nCount As Long) As Long Declare PtrSafe Function EnumClipboardFormats Lib "user32" (ByVal wFormat As Long) As Long' --------------------------------------------------------------------
' Other useful APIs' --------------------------------------------------------------------
Private Declare PtrSafe Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As LongPtr) As LongPtr Private Declare PtrSafe Function GlobalFree 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 GlobalSize Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr Private Declare PtrSafe Function GlobalUnlock Lib "kernel32" (ByVal hMem As LongPtr) As Long Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pTo As Any, uFrom As Any, ByVal lSize As Long) Private Declare PtrSafe Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, ByVal lpString2 As Any) As LongPtr' --------------------------------------------------------------------
Private Const GMEM_FIXED As Long = &H0' --------------------------------------------------------------------
' Predefined Clipboard Formats' --------------------------------------------------------------------
Private Const CF_TEXT As Long = 1 Private Const CF_BITMAP As Long = 2 Private Const CF_METAFILEPICT As Long = 3 Private Const CF_SYLK As Long = 4 Private Const CF_DIF As Long = 5 Private Const CF_TIFF As Long = 6 Private Const CF_OEMTEXT As Long = 7 Private Const CF_DIB As Long = 8 Private Const CF_PALETTE As Long = 9 Private Const CF_PENDATA As Long = 10 Private Const CF_RIFF As Long = 11 Private Const CF_WAVE As Long = 12 Private Const CF_UNICODETEXT As Long = 13 Private Const CF_ENHMETAFILE As Long = 14 Private Const CF_HDROP As Long = 15 Private Const CF_LOCALE As Long = 16 Private Const CF_MAX As Long = 17 Private Const CF_OWNERDISPLAY As Long = &H80 Private Const CF_DSPTEXT As Long = &H81 Private Const CF_DSPBITMAP As Long = &H82 Private Const CF_DSPMETAFILEPICT As Long = &H83 Private Const CF_DSPENHMETAFILE As Long = &H8E' -------------------------------------------------------------------- ' Public Methods ' --------------------------------------------------------------------
Public Function GetFormat(ByVal Format As Long) As Boolean' Check if the requested format is available ' on the clipboard. (Same behavior as standard ' VB Clipboard object)
If OpenClipboard(0&) Then If IsClipboardFormatAvailable(Format) Then GetFormat = True End If Call CloseClipboard End If End Function' --------------------------------------------------------------------
Public Function GetPriorityFormat(ParamArray Formats()) As Long Dim Fmts() As Long Dim i As Long Dim nFmt As Long' Bail, if no formats were requested
If UBound(Formats) < 0 Then Exit Function' Transfer desired formats into a non-variant array
ReDim Fmts(0 To UBound(Formats)) As Long For i = 0 To UBound(Formats)' Double conversion, to be safer. ' Could error trap, but that'd mean the ' user was a hoser, and we wouldn't want ' to insinuate *that*, would we?
Fmts(i) = CLng(Val(Formats(i))) Next i' Try opening clipboard...
If OpenClipboard(0&) Then' Check to see which format is highest in list
nFmt = GetPriorityClipboardFormat(Fmts(0), UBound(Fmts) + 1) Call CloseClipboard Else' Clipboard may already be open by another ' routine in same process, try anyway to see ' if we can get a successful result. Not ' clean, but worth a shot
nFmt = GetPriorityClipboardFormat(Fmts(0), UBound(Fmts) + 1) End If' Return results
GetPriorityFormat = nFmt End Function' --------------------------------------------------------------------
Public Function GetText() As String Dim nFmt As Long Dim hData As Long Dim lpData As Long' Check for desired format
nFmt = Me.GetPriorityFormat(CF_TEXT, CF_OEMTEXT, CF_DSPTEXT)' -1=None requested, 0=Empty
If nFmt > 0 Then' Grab text from clipboard, if available
If OpenClipboard(0&) Then hData = GetClipboardData(nFmt)' Slurp characters from global memory
If hData Then lpData = GlobalLock(hData) GetText = PointerToStringA(lpData) Call GlobalUnlock(hData) End If Call CloseClipboard End If End If End Function' --------------------------------------------------------------------
Public Function SetText(ByVal NewVal As String) As Boolean Dim hData As Long Dim lpData As Long Dim Buffer() As Byte' Try to set text onto clipboard
If OpenClipboard(0&) Then' Convert data to ANSI byte array
Buffer = StrConv(NewVal & vbNullChar, vbFromUnicode)' Allocate enough memory for buffer
hData = GlobalAlloc(GMEM_FIXED, UBound(Buffer) + 1) If hData Then' Copy data to alloc'd memory
lpData = GlobalLock(hData) Call CopyMemory(ByVal lpData, Buffer(0), UBound(Buffer) + 1) Call GlobalUnlock(hData)' Hand data off to clipboard
SetText = CBool(SetClipboardData(CF_TEXT, hData)) End If Call CloseClipboard End If End Function' -------------------------------------------------------------------- ' Private Methods ' --------------------------------------------------------------------
Private Function PointerToStringA(ByVal lpStringA As Long) As String Dim Buffer() As Byte Dim nLen As Long If lpStringA Then nLen = lstrlenA(ByVal lpStringA) If nLen Then ReDim Buffer(0 To (nLen - 1)) As Byte CopyMemory Buffer(0), ByVal lpStringA, nLen PointerToStringA = StrConv(Buffer, vbUnicode) End If End If End Function