Discussion :

[Daniel.C]

Bonjour à tous,

J'utilise ce code pour remplir le presse-papiers sans le comprendre (je l'ai seulement copié) :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
'Handle 64-bit and 32-bit Office
#If VBA7 Then
  Declare PtrSafe Function GlobalUnlock Lib "kernel32" (ByVal hMem As LongPtr) As Long
  Declare PtrSafe Function GlobalLock Lib "kernel32" (ByVal hMem As LongPtr) As Long
  Declare PtrSafe Function GlobalAlloc Lib "kernel32" (ByVal wFlags As LongPtr, _
    ByVal dwBytes As LongPtr) As Long
  Declare PtrSafe Function CloseClipboard Lib "User32" () As Long
  Declare PtrSafe Function OpenClipboard Lib "User32" (ByVal hwnd As LongPtr) As Long
  Declare PtrSafe Function EmptyClipboard Lib "User32" () As Long
  Declare PtrSafe Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, _
    ByVal lpString2 As Any) As LongPtr
  Declare PtrSafe Function SetClipboardData Lib "User32" (ByVal wFormat _
    As LongPtr, ByVal hMem As LongPtr) As Long
#Else
  Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
  Declare Function GlobalLock 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
#End If
 
Public Const GHND = &H42
Public Const CF_TEXT = 1
Public Const MAXSIZE = 4096
 
Function ClipBoard_SetData(MyString As String)
'PURPOSE: API function to copy text to clipboard
'SOURCE: www.msdn.microsoft.com/en-us/library/office/ff192913.aspx
 
Dim hGlobalMemory As Long, lpGlobalMemory As Long
Dim hClipMemory As Long, X As Long
 
'Allocate moveable global memory
  hGlobalMemory = GlobalAlloc(GHND, Len(MyString) + 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, MyString)
 
'Unlock the memory.
  If GlobalUnlock(hGlobalMemory) <> 0 Then
    MsgBox "Could not unlock memory location. Copy aborted."
    GoTo OutOfHere2
  End If
 
'Open the Clipboard to copy data to.
  If OpenClipboard(0&) = 0 Then
    MsgBox "Could not open the Clipboard. Copy aborted."
    Exit Function
  End If
 
'Clear the Clipboard.
  X = EmptyClipboard()
 
'Copy the data to the Clipboard.
  hClipMemory = SetClipboardData(CF_TEXT, hGlobalMemory)
 
OutOfHere2:
  If CloseClipboard() = 0 Then
    MsgBox "Could not close Clipboard."
  End If
 
End Function
 
Sub CopyTextToClipboard()
'PURPOSE: Copy a given text to the clipboard (using Windows API)
'SOURCE: www.TheSpreadsheetGuru.com
'NOTES: Must have above API declaration and ClipBoard_SetData function in your code
 
Dim Txt As String
 
'Put some text inside a string variable
  Txt = "This was copied to the clipboard using VBA!"
 
'Place text into the Clipboard
   ClipBoard_SetData Txt
 
 
End Sub

Il fonctionne sans problème sur mon Excel 2016 32 bits - Windows 10 64 bits. J'ai un utilisateur pour lequel la ligne :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

lpGlobalMemory = lstrcpy(lpGlobalMemory, MyString)

renvoie l'erreur :

"Erreur de compilation : Incompatibilité de type".

Merci d'avance à celui qui me dépannera.

[Invité]

Bonjour Daniel,

Code avec Patrick on ce demandait si ça fonctionnait sur 64Bits! :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Const DATAOBJECT_BINDING AsString = "new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}"
Public Property Let PressePapier(Value)
    With CreateObject(DATAOBJECT_BINDING)
        .SetText Value
        .PutInClipboard
    End With
End Property
 
 
Public Property Get PressePapier()
    With CreateObject(DATAOBJECT_BINDING)
        .GetFromClipboard
        PressePapier = .GetText
    End With
End Property
 
 
Private Sub test()
PressePapier = "toto"
Debug.Print PressePapier EndSub

https://msdn.microsoft.com/en-us/lib...ffice.14).aspx

Type	Item	Description
Qualifier	PtrSafe	Indicates that the Declare statement is compatible with 64-bits. This attribute is mandatory on 64-bit systems.
Data Type	LongPtr	A variable data type which is a 4-bytes data type on 32-bit versions and an 8-byte data type on 64-bit versions of Office 2010. This is the recommended way of declaring a pointer or a handle for new code but also for legacy code if it has to run in the 64-bit version of Office 2010. It is only supported in the VBA 7 runtime on 32-bit and 64-bit. Note that you can assign numeric values to it but not numeric types.
Data Type	LongLong	This is an 8-byte data type which is available only in 64-bit versions of Office 2010. You can assign numeric values but not numeric types (to avoid truncation).
Conversion Operator	CLngPtr	Converts a simple expression to a LongPtr data type.
Conversion Operator	CLngLng	Converts a simple expression to a LongLong data type.
Function	VarPtr	Variant converter. Returns a LongPtr on 64-bit versions, and a Long on 32-bit versions (4 bytes).
Function	ObjPtr	Object converter. Returns a LongPtr on 64-bit versions, and a Long on 32-bit versions (4 bytes).
Function	StrPtr	String converter. Returns a LongPtr on 64-bit versions, and a Long on 32-bit versions (4 bytes).

[Daniel.C]

Bonjour et merci.

Pour moi, c'est de l'hébreu... Je teste, j'envoie à mon utilisateur et je vous fais retour dès que j'ai la réponse.

Cordialement.

Daniel

[patricktoulon]

re
et le meme avec lobject htmlfile mon préféré

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
Public Property Let PressePapier(Value)
    With CreateObject("htmlfile")
          r = .parentwindow.clipboardData.setData("Text", Value)  
         End With
End Property
 
Public Property Get PressePapier()
    With CreateObject("htmlfile")
        PressePapier = .parentwindow.clipboardData.GetData("TEXT")
     End With
End Property

sub de teste

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
Private Sub test()
PressePapier = "toto"
Debug.Print PressePapier
End Sub

autre sub de test

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
Private Sub test2()
Range("A1:b3").Copy
MsgBox Replace(PressePapier, vbTab, " ")
End Sub

c'é bo la vie non?

[Daniel.C]

c'é bo la vie non?

Je te dis ça demain.

Cordialement.

Daniel

[Daniel.C]

Bonjour à tous,

@ dysorthographie : Merci pour le code. Je le teste dès que possible.
Merci Patrick, le code fonctionne ici. Il reste à le tester chez l'utilisateur. Si j'avais encore des problèmes, je reviendrais vers toi.

Cordialement.

Daniel

[patricktoulon]

re
Bonjour Daniel
pas de soucis
pour ma part je l'ai testé de 2007 a 2016 et ca fonctionne en 32/64 bits

[Daniel.C]

Ta solution a débloqué mes utilisateurs. Je vous transmets (à toi et à dysorthographie) mes remerciements et ceux de mes utilisateurs.

Bonne fin de journée.

Daniel

[patricktoulon]

re
de rien
je testerait egalement avec l'objectdata sur toute les versions
pour info
il y avait une contrib qui n'etait pas a proprement parler sur ton sujet mais dans la quelle tu aurait trouvé certainement ton bonheur
https://www.developpez.net/forums/d1...s-differentes/