View Single Post
  #4   Report Post  
Posted to microsoft.public.excel.programming
Jim Rech Jim Rech is offline
external usenet poster
 
Posts: 2,718
Default Why is my clipboard empty?

I think leaving the Msgbox up is a good idea. Some developers in my shop
have used that technique without any problems.

If, by any chance, you are only interested in pasting the Excel data into
Word (no formats) you can do a non-Excel copy by using Windows API calls.
With these you do not have to worry about Excel clearing the clipboard on
you. It's basically the same as highlighting what's in the formula bar and
doing a Ctrl-c, only it can work on a range. Fwiw, the code is below. It
works on the current selection so you'd have to modify it to work on a range
object.

--
Jim Rech
Excel MVP

Public Declare Function GlobalAlloc32 Lib "Kernel32" Alias "GlobalAlloc" _
(ByVal wFlags As Long, ByVal dwBytes As Long) As Long

Public Declare Function GlobalLock32 Lib "Kernel32" Alias "GlobalLock" _
(ByVal hMem As Long) As Long

Public Declare Function OpenClipboard32 Lib "user32" Alias "OpenClipboard" _
(ByVal hwnd As Long) As Long

Public Declare Function GlobalUnlock32 Lib "Kernel32" Alias "GlobalUnlock" _
(ByVal hMem As Long) As Long

Public Declare Function lstrcpy32 Lib "Kernel32" Alias "lstrcpy" _
(ByVal lpString1 As Any, ByVal lpString2 As Any) As Long

Public Declare Function CloseClipboard32 Lib "user32" Alias "CloseClipboard"
() As Long

Public Declare Function SetClipBoardData32 Lib "user32" _
Alias "SetClipboardData" (ByVal wFormat As Long, ByVal hMem As Long) As
Long

Declare Function GetClipboardData32 Lib "user32" Alias _
"GetClipboardData" (ByVal wFormat As Long) As Long

Declare Function EmptyClipboard32 Lib "user32" Alias "EmptyClipboard" () As
Long

Global Const CF_TEXT = 1

''Call this
Sub CB_SendData()
Dim StrBuf As String
Dim CurrRow As Range, CurrCell As Range
'Build a long string of cell values
' Tabs separate columns
' Carriage returns separate rows
For Each CurrRow In Selection.Rows
For Each CurrCell In CurrRow.Cells
StrBuf = StrBuf & CurrCell.Value & Chr(9)
Next
'Remove last Tab on row and add carriage return
StrBuf = Left(StrBuf, Len(StrBuf) - 1) & Chr(13)
Next
ClipBoard_SetData StrBuf
End Sub


Sub ClipBoard_SetData(MyString As String)
Dim hGlobalMemory As Long, lpGlobalMemory As Long
Dim hClipMemory As Long
' Allocate moveable global memory.
hGlobalMemory = GlobalAlloc32(&H42, Len(MyString) + 1)
' Lock the block to get a far pointer to this memory.
lpGlobalMemory = GlobalLock32(hGlobalMemory)
' Copy the string to this global memory.
lpGlobalMemory = lstrcpy32(lpGlobalMemory, MyString)
' Unlock the memory.
If GlobalUnlock32(hGlobalMemory) < 0 Then
MsgBox "Could not unlock memory location. Copy aborted."
GoTo OutOfHere
End If
' Open the Clipboard to copy data to.
If OpenClipboard32(0&) = 0 Then
MsgBox "Could not open the Clipboard. Copy aborted."
Exit Sub
End If
EmptyClipboard32 'Don't know if I really need this
' Copy the data to the Clipboard.
hClipMemory = SetClipBoardData32(CF_TEXT, hGlobalMemory)
OutOfHe
If CloseClipboard32() = 0 Then
MsgBox "Could not close Clipboard."
End If
End Sub