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
|