Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire
Veuillez sélectionner un problème
Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Gilbert
Bonjour,
Voici des fonctions permettant d'utiliser le presse-papier
Option Compare Database Option Explicit
Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long Declare Function CloseClipboard Lib "User32" () As Long Declare Function OpenClipboard Lib "User32" (ByVal hwnd As Long) As Long Declare Function EmptyClipboard Lib "User32" () As Long Declare Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long Declare Function SetClipboardData Lib "User32" (ByVal wFormat As Long, ByVal hMem As Long) As Long Declare Function GetClipboardData Lib "User32" (ByVal wFormat As Long) As Long
Public Const GHND = &H42 Public Const CF_TEXT = 1 Public Const MAXSIZE = 4096
Function ClipBoard_SetData(MyString As String) Dim hGlobalMemory As Long, lpGlobalMemory As Long Dim hClipMemory As Long, X As Long
hGlobalMemory = GlobalAlloc(GHND, Len(MyString) + 1) lpGlobalMemory = GlobalLock(hGlobalMemory) lpGlobalMemory = lstrcpy(lpGlobalMemory, MyString) If GlobalUnlock(hGlobalMemory) <> 0 Then MsgBox "Could not unlock memory location. Copy aborted." GoTo OutOfHere2 End If
If OpenClipboard(0&) = 0 Then MsgBox "Could not open the Clipboard. Copy aborted." Exit Function End If
X = EmptyClipboard() hClipMemory = SetClipboardData(CF_TEXT, hGlobalMemory) OutOfHere2: If CloseClipboard() = 0 Then MsgBox "Could not close Clipboard." End If End Function
Function ClipBoard_GetData() Dim hClipMemory As Long Dim lpClipMemory As Long Dim MyString As String Dim RetVal As Long
If OpenClipboard(0&) = 0 Then MsgBox "Cannot open Clipboard. Another app. may have it open" Exit Function End If
hClipMemory = GetClipboardData(CF_TEXT) If IsNull(hClipMemory) Then MsgBox "Could not allocate memory" GoTo OutOfHere End If
lpClipMemory = GlobalLock(hClipMemory) If Not IsNull(lpClipMemory) Then MyString = Space$(MAXSIZE) RetVal = lstrcpy(MyString, lpClipMemory) RetVal = GlobalUnlock(hClipMemory) MyString = Mid(MyString, 1, InStr(1, MyString, Chr$(0), 0) - 1) Else MsgBox "Could not lock memory to copy string from." End If
OutOfHere: RetVal = CloseClipboard() ClipBoard_GetData = MyString End Function
Function ClipBoard_Clear(Frm As Form) OpenClipboard Frm.hwnd EmptyClipboard CloseClipboard End Function
-- Cordialement,
Gilbert
"michel_bdx" a écrit dans le message de news:
comment copier le contenu d'une zone texte dans le presse-papier pour s'en servir plus tard
michel
Bonjour,
Voici des fonctions permettant d'utiliser le presse-papier
Option Compare Database
Option Explicit
Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long
Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal
dwBytes As Long) As Long
Declare Function CloseClipboard Lib "User32" () As Long
Declare Function OpenClipboard Lib "User32" (ByVal hwnd As Long) As Long
Declare Function EmptyClipboard Lib "User32" () As Long
Declare Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, ByVal
lpString2 As Any) As Long
Declare Function SetClipboardData Lib "User32" (ByVal wFormat As Long, ByVal
hMem As Long) As Long
Declare Function GetClipboardData Lib "User32" (ByVal wFormat As Long) As
Long
Public Const GHND = &H42
Public Const CF_TEXT = 1
Public Const MAXSIZE = 4096
Function ClipBoard_SetData(MyString As String)
Dim hGlobalMemory As Long, lpGlobalMemory As Long
Dim hClipMemory As Long, X As Long
hGlobalMemory = GlobalAlloc(GHND, Len(MyString) + 1)
lpGlobalMemory = GlobalLock(hGlobalMemory)
lpGlobalMemory = lstrcpy(lpGlobalMemory, MyString)
If GlobalUnlock(hGlobalMemory) <> 0 Then
MsgBox "Could not unlock memory location. Copy aborted."
GoTo OutOfHere2
End If
If OpenClipboard(0&) = 0 Then
MsgBox "Could not open the Clipboard. Copy aborted."
Exit Function
End If
X = EmptyClipboard()
hClipMemory = SetClipboardData(CF_TEXT, hGlobalMemory)
OutOfHere2:
If CloseClipboard() = 0 Then
MsgBox "Could not close Clipboard."
End If
End Function
Function ClipBoard_GetData()
Dim hClipMemory As Long
Dim lpClipMemory As Long
Dim MyString As String
Dim RetVal As Long
If OpenClipboard(0&) = 0 Then
MsgBox "Cannot open Clipboard. Another app. may have it open"
Exit Function
End If
hClipMemory = GetClipboardData(CF_TEXT)
If IsNull(hClipMemory) Then
MsgBox "Could not allocate memory"
GoTo OutOfHere
End If
lpClipMemory = GlobalLock(hClipMemory)
If Not IsNull(lpClipMemory) Then
MyString = Space$(MAXSIZE)
RetVal = lstrcpy(MyString, lpClipMemory)
RetVal = GlobalUnlock(hClipMemory)
MyString = Mid(MyString, 1, InStr(1, MyString, Chr$(0), 0) - 1)
Else
MsgBox "Could not lock memory to copy string from."
End If
OutOfHere:
RetVal = CloseClipboard()
ClipBoard_GetData = MyString
End Function
Function ClipBoard_Clear(Frm As Form)
OpenClipboard Frm.hwnd
EmptyClipboard
CloseClipboard
End Function
--
Cordialement,
Gilbert
"michel_bdx" <michelbdx@discussions.microsoft.com> a écrit dans le message
de news:9F75971E-C259-43AC-AB97-01E8AA34BB60@microsoft.com...
comment copier le contenu d'une zone texte dans le presse-papier pour s'en
servir plus tard
Voici des fonctions permettant d'utiliser le presse-papier
Option Compare Database Option Explicit
Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long Declare Function CloseClipboard Lib "User32" () As Long Declare Function OpenClipboard Lib "User32" (ByVal hwnd As Long) As Long Declare Function EmptyClipboard Lib "User32" () As Long Declare Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long Declare Function SetClipboardData Lib "User32" (ByVal wFormat As Long, ByVal hMem As Long) As Long Declare Function GetClipboardData Lib "User32" (ByVal wFormat As Long) As Long
Public Const GHND = &H42 Public Const CF_TEXT = 1 Public Const MAXSIZE = 4096
Function ClipBoard_SetData(MyString As String) Dim hGlobalMemory As Long, lpGlobalMemory As Long Dim hClipMemory As Long, X As Long
hGlobalMemory = GlobalAlloc(GHND, Len(MyString) + 1) lpGlobalMemory = GlobalLock(hGlobalMemory) lpGlobalMemory = lstrcpy(lpGlobalMemory, MyString) If GlobalUnlock(hGlobalMemory) <> 0 Then MsgBox "Could not unlock memory location. Copy aborted." GoTo OutOfHere2 End If
If OpenClipboard(0&) = 0 Then MsgBox "Could not open the Clipboard. Copy aborted." Exit Function End If
X = EmptyClipboard() hClipMemory = SetClipboardData(CF_TEXT, hGlobalMemory) OutOfHere2: If CloseClipboard() = 0 Then MsgBox "Could not close Clipboard." End If End Function
Function ClipBoard_GetData() Dim hClipMemory As Long Dim lpClipMemory As Long Dim MyString As String Dim RetVal As Long
If OpenClipboard(0&) = 0 Then MsgBox "Cannot open Clipboard. Another app. may have it open" Exit Function End If
hClipMemory = GetClipboardData(CF_TEXT) If IsNull(hClipMemory) Then MsgBox "Could not allocate memory" GoTo OutOfHere End If
lpClipMemory = GlobalLock(hClipMemory) If Not IsNull(lpClipMemory) Then MyString = Space$(MAXSIZE) RetVal = lstrcpy(MyString, lpClipMemory) RetVal = GlobalUnlock(hClipMemory) MyString = Mid(MyString, 1, InStr(1, MyString, Chr$(0), 0) - 1) Else MsgBox "Could not lock memory to copy string from." End If
OutOfHere: RetVal = CloseClipboard() ClipBoard_GetData = MyString End Function
Function ClipBoard_Clear(Frm As Form) OpenClipboard Frm.hwnd EmptyClipboard CloseClipboard End Function
-- Cordialement,
Gilbert
"michel_bdx" a écrit dans le message de news:
comment copier le contenu d'une zone texte dans le presse-papier pour s'en servir plus tard