On 27 Sep., 23:26, Per <Jens...@Hotmail.com> wrote:
> Peter < pb-cons...@get2net.dk > skrev følgende:
>
> > Hej Gruppe
>
> > Jeg skal bruge noget hjælp til at sende en string til clipboard, fra
> > access til en dialogboks i word hvor jeg vil paste værdien ind.
>
> > Jeg har ligget på forskellige løsninger men er ikke sikker på at jeg
> > kan bruge dem.
>
> > Hilsen
>
> > Peter
>
> Hej Peter,
>
> Kopier nedennævnte kode til et modul:
>
> Option Explicit
>
> '********* Code Start ************
> ' This code was originally written by Terry Kreft.
> ' It is not to be altered or distributed,
> ' except as part of an application.
> ' You are free to use it in any application,
> ' provided the copyright notice is left unchanged.
> '
> ' Code Courtesy of
> ' Terry Kreft
> '
>
> Public Const GHND = &H42
> Public Const CF_TEXT = 1
> Private Const CF_ANSIONLY = &H400&
> Private Const CF_APPLY = &H200&
> Private Const CF_BITMAP = 2
> Private Const CF_DIB = 8
> Private Const CF_DIF = 5
> Private Const CF_DSPBITMAP = &H82
> Private Const CF_DSPENHMETAFILE = &H8E
> Private Const CF_DSPMETAFILEPICT = &H83
> Private Const CF_DSPTEXT = &H81
> Private Const CF_EFFECTS = &H100&
> Private Const CF_ENABLEHOOK = &H8&
> Private Const CF_ENABLETEMPLATE = &H10&
> Private Const CF_ENABLETEMPLATEHANDLE = &H20&
> Private Const CF_ENHMETAFILE = 14
> Private Const CF_FIXEDPITCHONLY = &H4000&
> Private Const CF_FORCEFONTEXIST = &H10000
> Private Const CF_GDIOBJFIRST = &H300
> Private Const CF_GDIOBJLAST = &H3FF
> Private Const CF_HDROP = 15
> Private Const CF_INITTOLOGFONTSTRUCT = &H40&
> Private Const CF_LIMITSIZE = &H2000&
> Private Const CF_LOCALE = 16
> Private Const CF_MAX = 17
> Private Const CF_METAFILEPICT = 3
> Private Const CF_NOFACESEL = &H80000
> Private Const CF_NOSCRIPTSEL = &H800000
> Private Const CF_NOSIMULATIONS = &H1000&
> Private Const CF_NOSIZESEL = &H200000
> Private Const CF_NOSTYLESEL = &H100000
> Private Const CF_NOVECTORFONTS = &H800&
> Private Const CF_NOOEMFONTS = CF_NOVECTORFONTS
> Private Const CF_NOVERTFONTS = &H1000000
> Private Const CF_OEMTEXT = 7
> Private Const CF_OWNERDISPLAY = &H80
> Private Const CF_PALETTE = 9
> Private Const CF_PENDATA = 10
> Private Const CF_PRINTERFONTS = &H2
> Private Const CF_PRIVATEFIRST = &H200
> Private Const CF_PRIVATELAST = &H2FF
> Private Const CF_RIFF = 11
> Private Const CF_SCALABLEONLY = &H20000
> Private Const CF_SCREENFONTS = &H1
> Private Const CF_BOTH = (CF_SCREENFONTS Or CF_PRINTERFONTS)
> Private Const CF_SCRIPTSONLY = CF_ANSIONLY
> Private Const CF_SELECTSCRIPT = &H400000
> Private Const CF_SHOWHELP = &H4&
> Private Const CF_SYLK = 4
> Private Const CF_TIFF = 6
> Private Const CF_TTONLY = &H40000
> Private Const CF_UNICODETEXT = 13
> Private Const CF_USESTYLE = &H80&
> Private Const CF_WAVE = 12
> Private Const CF_WYSIWYG = &H8000
>
> 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 lstrlen Lib "kernel32" Alias "lstrlenA" _
> (ByVal lpString As String) 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
>
> Function ClipBoard_SetText(strCopyString As String) As Boolean
> Dim hGlobalMemory As Long
> Dim lpGlobalMemory As Long
> Dim hClipMemory As Long
>
> ' 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
>
> '********* Code End ************
>
> Her får du så muligheden for både at indlæse og udlæse data til og fra
> Clipboard'et.
>
> PS ! Håber du har ligget godt...
>
> --
> Med venlig hilsen
>
> Per
Ja jeg har ligget godt, og det virker tak for hurtigt svar.
Hilsen
Peter