Results 1 to 9 of 9
  1. #1
    Star Lounger
    Join Date
    Feb 2005
    Posts
    50
    Thanks
    6
    Thanked 0 Times in 0 Posts

    Load Clipboard with text from Excel using VB

    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, <F2> , <Home> , <Ctrl> / <Shift> / <End> , <Ctrl> <C> , <Enter>

    Id 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.

  2. #2
    Gold Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    2,640
    Thanks
    115
    Thanked 651 Times in 593 Posts
    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()
    'CONCATENATE AND COPY VALUE TO STORAGE CELL
    '------------------------------------------------
    'ASSIGN KEYBOARD SHORTCUT Ctrl-Shft-C
    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()
    'INSERT STORED VALUE TO SELECTED CELL
    '--------------------------------------------------
    'ASSIGN KEYBOARD SHORTCUT Ctrl-Shft-V
    ActiveCell.Value = Worksheets("Cpboard").Range("A1")
    End Sub
    HTH,
    Maud
    Attached Files Attached Files

  3. #3
    Gold Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    2,640
    Thanks
    115
    Thanked 651 Times in 593 Posts
    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
    Attached Files Attached Files
    Last edited by Maudibe; 2015-01-30 at 18:15.

  4. #4
    Star Lounger
    Join Date
    Feb 2005
    Posts
    50
    Thanks
    6
    Thanked 0 Times in 0 Posts

    Further refinements

    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.c...ows-clipboard/

    and it refers to: http://excel-macro.tutorialhorizon.c...xcel-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.

  5. #5
    Gold Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    2,640
    Thanks
    115
    Thanked 651 Times in 593 Posts
    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.
    Attached Files Attached Files
    Last edited by Maudibe; 2015-01-31 at 00:41.

  6. The Following User Says Thank You to Maudibe For This Useful Post:

    Antediluvian (2015-01-31)

  7. #6
    Gold Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    2,640
    Thanks
    115
    Thanked 651 Times in 593 Posts
    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)
    'REFERENCE MICROSOFT FORMS 2.0 (FM20.DLL)
        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
    Attached Files Attached Files

  8. #7
    Star Lounger
    Join Date
    Feb 2005
    Posts
    50
    Thanks
    6
    Thanked 0 Times in 0 Posts

    Your Excellent Solution with variations

    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).

  9. #8
    WS Lounge VIP rory's Avatar
    Join Date
    Dec 2000
    Location
    Burwash, East Sussex, United Kingdom
    Posts
    6,280
    Thanks
    3
    Thanked 191 Times in 177 Posts
    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.
    Regards,
    Rory

    Microsoft MVP - Excel

  10. The Following User Says Thank You to rory For This Useful Post:

    Maudibe (2015-02-03)

  11. #9
    Gold Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    2,640
    Thanks
    115
    Thanked 651 Times in 593 Posts
    Good to know rory!

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •