Set Clipboard Text

[Michael DELIQUE]

Code : Tout sélectionner

Public Sub SetClipboardText_API(text As String)
   
%REM
'Variables API pour la fonction SetClipboardText_API
Declare Function CloseClipboard Lib "user32" Alias "CloseClipboard" () As Long
Declare Function NEMGetCurrentSubprogramWindow Lib "nnotesws.dll" () As Long
Declare Function SetClipboardData Lib "user32" Alias "SetClipboardData" (Byval wFormat As Long, Byval hMem As Long) As Long
Declare Function EmptyClipboard Lib "user32" Alias "EmptyClipboard" () As Long
Declare Function OpenClipboard Lib "user32" Alias "OpenClipboard" (Byval hwnd As Long) As Long
Declare Function GlobalAlloc Lib "kernel32" Alias "GlobalAlloc" (Byval wFlags As Long, Byval dwBytes As Long) As Long
Declare Function GlobalLock Lib "kernel32" Alias "GlobalLock" (Byval hMem As Long) As Long
Declare Function GlobalUnlock Lib "kernel32" Alias "GlobalUnlock" (Byval hMem As Long) As Long
Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (Byval lpString1 As Long, Byval lpString2 As String) As Long
%END REM
   
   'Déclaration Variables
   Dim hwnd As Long
   Dim hGlobalMemory As Long
   Dim lpGlobalMemory As Long
   Dim ret As Long
   
   On Error Goto ErreurSetClipboardText_API
   
' Get a handle to current window
   hwnd = NEMGetCurrentSubProgramWindow()
   If hwnd Then
' Allocate memory
      hGlobalMemory = GlobalAlloc(Clng(GMEM_MOVEABLE Or GMEM_ZEROINIT), Clng(Len(text)+1))
      If hGlobalMemory Then
         lpGlobalMemory = GlobalLock(hGlobalMemory)
         If lpGlobalMemory Then
' Copy text to global memory
            ret = lstrcpy(lpGlobalMemory, text)
            Call GlobalUnlock(hGlobalMemory)
' Set clipboard contents
            If OpenClipboard(hwnd) Then
               ret = EmptyClipboard()
               ret = SetClipboardData(CF_TEXT, hGlobalMemory)
               ret = CloseClipboard()
            End If
         Else
            Error 9999,"Can't allocated global memory pointer."
         End If
      Else
         Error 9999,"Can't allocated global memory handle."
      End If
   Else
      Error 9999,"Can't get window handle."
   End If
   
   Exit Sub
ErreurSetClipboardText_API:
   Msgbox "("+Cstr(Getthreadinfo (1))+" Call by "+Cstr(Getthreadinfo(10))+")"+Chr(10)+"Erreur " + Str(Err) + " : "+Chr(10) + Cstr(Error)+". "+Chr(10)+"Ligne N° "+Cstr(Erl),16," ERREUR !"
   Exit Sub
End Sub