Option Explicit

Public Const GHND = &H42
Public Const CF_TEXT = 1

Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags&, ByVal _
dwBytes
As Long) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) _
As Long
Private Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) _
As Long
Private Declare Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, _
ByVal lpString2 As Any) As
Long
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) _
As Long
Private Declare Function OpenClipboard Lib "user32" (ByVal Hwnd As Long) _
As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As _
Long) As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long
Private Declare Function SetClipboardData Lib "user32" (ByVal wFormat _
As Long, ByVal hMem
As Long) As Long


Public Function ClipBoard_SetText(strCopyString As String) As Boolean

Dim hGlobalMemory As Long
Dim lpGlobalMemory As Long
Dim hClipMemory As Long

'this is an example of how this works
'------------------------------------
'Dim strString As String
'strString = "test"
'ClipBoard_SetText strString
'------------------------------------

'Allocate moveable global memory
'-------------------------------
hGlobalMemory = GlobalAlloc(GHND, Len(strCopyString) + 1)

'Lock the block to get a far pointer to this memory
'--------------------------------------------------
lpGlobalMemory = GlobalLock(hGlobalMemory)

'Copy the string to this global memory
'-------------------------------------
lpGlobalMemory = lstrcpy(lpGlobalMemory, strCopyString)

'Unlock the memory and then copy to the clipboard
'------------------------------------------------
If GlobalUnlock(hGlobalMemory) = 0 Then
If OpenClipboard(0&) < 0 Then
Call EmptyClipboard
hClipMemory = SetClipboardData(CF_TEXT, hGlobalMemory)
ClipBoard_SetText = CBool(CloseClipboard)
End If
End If

End Function

Function ClipBoard_GetText() As String

Dim hClipMemory As Long
Dim lpClipMemory As Long
Dim strCBText As String
Dim retval As Long
Dim lngSize As Long

If OpenClipboard(0&) < 0 Then
'Obtain the handle to the global
'memory block that is referencing the text
'----------------------------------------
hClipMemory = GetClipboardData(CF_TEXT)
If hClipMemory < 0 Then
'Lock Clipboard memory so we can
'reference the actual data string
'--------------------------------
lpClipMemory = GlobalLock(hClipMemory)
If lpClipMemory < 0 Then
lngSize = GlobalSize(lpClipMemory)
strCBText = Space$(lngSize)
retval = lstrcpy(strCBText, lpClipMemory)
retval = GlobalUnlock(hClipMemory)
'Peel off the null terminating character
'---------------------------------------
strCBText = Left(strCBText, InStr(1, strCBText, Chr$(0),
0) - 1)
Else
MsgBox "Could not lock memory to copy string from."
End If
End If
Call CloseClipboard
End If

ClipBoard_GetText = strCBText

End Function


Sub tester()

Dim strTest As String

ClipBoard_SetText "This is a clipboard test"

strTest = ClipBoard_GetText

End Sub


Can't remember where I got it from, but I know it works perfect.
Works all with API, so no extra libraries needed.

RBS


"PaulD" <nospam wrote in message
...
"Jos Vens" wrote in message
...
: Hi,
:
: I wonder if you can put some predefined text on the clipboard (not the
: contents of a cell - dashed line) but a text like you should copy in any
: program (and like you can copy a part of text in the formulabar of a
whole
: line).
:
: I'd like to paste it back when I'm inputting in a cell when the user
needs
: it (ctrl-v works then).
:
: thanks
: Jos Vens
:
Not sure I fully understand, are you looking for something like this?

Sub Macro1()
Dim MyData As DataObject
Set MyData = New DataObject
MyData.SetText "Enter what you want on the clipboard here"
MyData.PutInClipboard
End Sub

In order to run since MyData is earlybind, you must go to tools reference
in
the VBA editor and select Microsoft Forms 2.0 Object Library. Or you can
change to late bind (i.e. use CreateObject)
Paul D