Load Clipboard with text from Excel using VB

Topic

New Reply

I use Excel 2003 under Windows 8.1 with Classic Shell. I need Excel 2003 as some needed facilities have been withdrawn subsequently. I use the old macro language and have very limited VB skills.

Text copied to the clipboard in other systems is permanent in Excel until the clipboard is cleared. Similarly objects copied to the clipboard in Excel are permanent in Excel until the clipboard is cleared. However cells copied to the clipboard in Excel are cancelled when Excel cells are altered.

I need a VB facility to put text onto the clipboard from cells within Excel that is permanent (as above). This is equivalent to the following keystrokes within Excel.

Select the cell, , , / / , ,

I’d be very grateful if someone could write a VB facility for me to do this.

My ideal would be for a facility of the form

XTextToClip(Range,Separator)

where Range is a range of cells and Separator is a small text string. The facility would add non-empty cells to the clipboard, with the Separator separating the non blank cells..

Example. For cells B1:B3 holding “Jack“, “and“, “Jill”
XTextToClip(B1:B3,” “) would put “Jack and Jill” onto the clipboard as text.

Reply | Quote

Replies

Antediluvian,

A real dirty but easy way to do this is to send the copied text to a cell on a hidden sheet. The hidden sheet essentially is your clipboard, however using this method, you can store multiple values and retrieve them at a later time by duplicating the code.

Here is some code that will take the selected cells, concatenate them with a space (ex Jack and Jill), and send it to the hidden sheet (Cpboard) into cell A1. I have assigned the macro to the keyboard shortcut of Ctrl-Shft-C. The second bit of code will pull the concatenated value from cell A1 on the hidden sheet and insert it in the selected Cell. I assigned tis macro to the keyboard shortcut of Ctrl-Shft-V.

So the procedure is:
1. Select the cell(s) to copy
2. Press Ctrl-Shft-C
3. Select the destination cell
4. Press Ctrl-Shft-V

Insert in a standard module

Code:

Public Sub TextToClip()
[COLOR=”#008000″]’CONCATENATE AND COPY VALUE TO STORAGE CELL
‘————————————————
‘ASSIGN KEYBOARD SHORTCUT Ctrl-Shft-C[/COLOR]
strng = “”
For Each cell In Selection
    If strng = “” Then
        strng = strng & cell
    Else:
        strng = strng & ” ” & cell
    End If
Next cell
Worksheets(“Cpboard”).Range(“A1″) = strng
End Sub




Public Sub ClipToXText()
[COLOR=”#008000”]’INSERT STORED VALUE TO SELECTED CELL
‘————————————————–
‘ASSIGN KEYBOARD SHORTCUT Ctrl-Shft-V[/COLOR]
ActiveCell.Value = Worksheets(“Cpboard”).Range(“A1”)
End Sub

HTH,
Maud

Reply | Quote

Thanks to both of you for your help. I think the basis of the code is there, especially the shorter version. However I was hoping to get a function that could be initiated from my code (I use the macro language, but that’s similar to Visual Basic for this context), not as a keyboard initiated macro. I’m also keen to put the result onto the clipboard as that will offer me a lot of advantages as I move from application to application and would value the permanancy of the clipboard as calculated in Excel. I’ve found a good references on the internet as to how to put the text onto the clipboard. It looks complex to me and I hope you’re able to do it. The major reference is:

http://excel-macro.tutorialhorizon.com/vba-excel-putting-text-in-the-windows-clipboard/

and it refers to: http://excel-macro.tutorialhorizon.com/vba-excel-reference-libraries-in-excel-workbook/

I would be extremely grateful if you could integrate the various aspects. A further benefit would be for the function to reply with TRUE or FALSE, depending on errors, though I know how to do that myself.

I’ve put two attachments in. The Word document is essentially the major reference above and the Excel woksheet shows a Help panel I’ll construct in code that I provide myself.

Reply | Quote

Here is some code from Microsoft’s web site that I modified from a function to a subroutine and added the capability of copying a selection of cells and appending into one value ready for pasting. I assigned the routine a Keyboard shortcut of Ctrl-Shft-Z.

1. Select the cell(s) to copy
2. Press Ctrl-Shft-Z
3. Select the destination cell
4. Press Ctrl-V

Paste code at the top of a standard module

Code:

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


Public Sub ClipBoard_SetData()
   Dim hGlobalMemory As Long, lpGlobalMemory As Long
   Dim hClipMemory As Long, X As Long
   Dim strng As String, MyString As String
   strng = “”
    For Each cell In Selection
        If strng = “” Then
            strng = strng & cell
        Else:
            strng = strng & ” ” & cell
        End If
    Next cell
   MyString = strng
   hGlobalMemory = GlobalAlloc(GHND, Len(MyString) + 1)
   lpGlobalMemory = GlobalLock(hGlobalMemory)
   lpGlobalMemory = lstrcpy(lpGlobalMemory, MyString)
   If GlobalUnlock(hGlobalMemory)  0 Then
      MsgBox “Could not unlock memory location. Copy aborted.”
      GoTo OutOfHere2
   End If
   If OpenClipboard(0&) = 0 Then
      MsgBox “Could not open the Clipboard. Copy aborted.”
      Exit Sub
   End If
   X = EmptyClipboard()
   hClipMemory = SetClipboardData(CF_TEXT, hGlobalMemory)
OutOfHere2:
   If CloseClipboard() = 0 Then
      MsgBox “Could not close Clipboard.”
   End If
End Sub

Reply | Quote

Here is the code converted to a function you described in your opening post. It is called using the format:

XTextToClip(Range,Separator)

This is a simple sample procedure to call the function. Place the call statement in your own code.

Code:

Public Sub CallProc()
XTextToClip Range(“A1:C1”), “/”
End Sub

Here is the function placed at the top of a standard module

Code:

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

Public Function XTextToClip(rng As Range, separator As String)
   Dim hGlobalMemory As Long, lpGlobalMemory As Long
   Dim hClipMemory As Long, X As Long
   Dim strng As String, MyString As String
   strng = “”
    For Each cell In rng
        If strng = “” Then
            strng = strng & cell
        Else:
            strng = strng & separator & cell
        End If
    Next cell
   MyString = strng
   hGlobalMemory = GlobalAlloc(GHND, Len(MyString) + 1)
   lpGlobalMemory = GlobalLock(hGlobalMemory)
   lpGlobalMemory = lstrcpy(lpGlobalMemory, MyString)
   If GlobalUnlock(hGlobalMemory)  0 Then
      MsgBox “Could not unlock memory location. Copy aborted.”
      GoTo OutOfHere2
   End If
   If OpenClipboard(0&) = 0 Then
      MsgBox “Could not open the Clipboard. Copy aborted.”
      Exit Function
   End If
   X = EmptyClipboard()
   hClipMemory = SetClipboardData(CF_TEXT, hGlobalMemory)
OutOfHere2:
   If CloseClipboard() = 0 Then
      MsgBox “Could not close Clipboard.”
   End If
End Function

the CallProc procedure will call the function that will concatenate the range of cells with the separator using the parameters you specified in the call. In this example the output to the clipboard is:

Jack/and/Jill

and will be available for any application. As a twist, you could also use this as an Excel UDF with the cell formula =XTextToClip(A1:C1, “/”) but I cannot think of a reason why anyone would want to as any sheet recalculation would load the active cell’s value to the clipboard.

Reply | Quote

Maudibe,

Thank you very much for your excellent solution. It will smooth my use of the computer a lot. I’ve chosen the longer solution as it does not require changes to the Excel environment when used on different computers.

I’ve made some variations as in the attachment. I’ve eliminated excess separators when cells are empty and the function replies TRUE on success and FALSE on failure (though FALSE does not work when I deliberately feed in invalid arguments).

Reply | Quote

Here is the same function referencing Microsoft Forms 2.0 instead of the Windows API above. The method and output is exactly the same.

Code:

Public Sub CallProc()
XTextToClip Range(“A1:C1”), “/”
End Sub

Code:

Function XTextToClip(rng As Range, separator As String)
[COLOR=”#008000″]’REFERENCE MICROSOFT FORMS 2.0 (FM20.DLL)[/COLOR]
    Dim objData As New MSForms.DataObject
    Dim strng As String
    strng = “”
    For Each cell In rng
        If strng = “” Then
            strng = strng & cell
        Else:
            strng = strng & separator & cell
        End If
    Next cell
    objData.SetText strng
    objData.PutInClipboard
End Function

Reply | Quote

Just FYI, I’d stick with the API version over the DataObject code. There’s a bug in Win8 using DataObject which can lead to the clipboard just containing two odd characters rather than whatever text you actually assigned to it.

Also, if you do use the Forms code, it would be more portable late bound rather than using the reference.

Reply | Quote

Good to know rory!

Reply | Quote