Discussion :

[Kestion100]

Je cherche à copier une valeur sélectionnée dans une listbox et la coller par contrôle v.

Lorsque je sélectionne ma ligne dans ma listbox, si je code:

Code :

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

Texte = ListBox2.List(ListBox2.ListIndex)

puis

Code :

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

MsgBox Texte

le texte sélectionné s'inscrit bien dans la MsgBox mais lorsque je fais mon contrôle v, dans une cellule Excel j'obtiens ce qui me semble être deux espaces et quand je fais mon contrôle v dans le texte de ma fenêtre de code, par exemple, j'obtiens 2 points d'interrogation.

Le code utilisé:

Code :

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

1
2
3
4
5
6
7
Texte = ListBox2.List(ListBox2.ListIndex)
 
Dim x As New DataObject
With x
    .SetText Texte
    .PutInClipboard
End With

D'où vient le problème????

Merci beaucoup pour le coup de main!!!!

BONNE ANNEE!!!!!!!!!!!!!!

[Qwazerty]

Salut

Il semble y avoir des problèmes avec DataObject quand il est utilisé sous Windows10. Je n'ai pas regardé dans le détail juste fait une recherche sur le web.

[Edit]

Je viens de faire l'essai sur l'ordi du boulot (Windows 10 ent.), aucun soucis avec ton code.
As-tu essayé de déclarer tes variables? Je pense notamment à Text, qui ici est déclaré par défaut comme un variant par VB (dû à l'absence de déclaration explicite de ta part).

J'ai regardé dans un fichier ou je savais avoir utilisé le clipboard pour un projet boulot, en effet je n'avais pas utilisé PutInClipboard mais je ne suis pas sûr que ce soit lié à un problème mais plutôt au besoin de pouvoir spécifier un format perso.
Bref, tu peux essayer ce code, à placer dans un Module standard

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
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
Option Explicit
 
'https://www.thespreadsheetguru.com/blog/2015/1/13/how-to-use-vba-code-to-copy-text-to-the-clipboard
'Modification pour pouvoir utiliser le formatId
'http://www.vbaccelerator.com/home/VB/Tips/Determine_All_Formats_On_Clipboard/article.html
 
 
'Handle 64-bit and 32-bit Office
#If VBA7 Then
    Public Declare PtrSafe Function GlobalUnlock Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
    Public Declare PtrSafe Function GlobalLock Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
    Public Declare PtrSafe Function GlobalAlloc Lib "kernel32" (ByVal wFlags As LongPtr, ByVal dwBytes As LongPtr) As LongPtr
    Public Declare PtrSafe Function CloseClipboard Lib "user32" () As LongPtr
    Public Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
    Public Declare PtrSafe Function EmptyClipboard Lib "user32" () As LongPtr
    Public Declare PtrSafe Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, ByVal lpString2 As Any) As LongPtr
    Public Declare PtrSafe Function SetClipboardData Lib "user32" (ByVal wFormat As LongPtr, ByVal hMem As LongPtr) As LongPtr
    Public Declare PtrSafe Function RegisterClipboardFormat Lib "user32" Alias "RegisterClipboardFormatA" (ByVal lpString As String) As LongPtr
    Public Declare PtrSafe Function IsClipboardFormatAvailable Lib "user32" (ByVal wFormat As LongPtr) As LongPtr
    Public Declare PtrSafe Function GetClipBoardData Lib "user32" Alias "GetClipboardData" (ByVal wFormat As LongPtr) As LongPtr
    Public Declare PtrSafe Function LoadString Lib "user32" Alias "LoadStringA" (ByVal hInstance As LongPtr, ByVal uID As LongPtr, ByVal lpBuffer As String, ByVal nBufferMax As LongPtr) As LongPtr
 
 
    Private pFormatDataCell As LongPtr
#Else
    Public Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
    Public Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
    Public Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
    Public Declare Function CloseClipboard Lib "user32" () As Long
    Public Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
    Public Declare Function EmptyClipboard Lib "user32" () As Long
    Public Declare Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long
    Public Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
    Public Declare Function RegisterClipboardFormat Lib "user32" Alias "RegisterClipboardFormatA" (ByVal lpString As String) As Long
    Public Declare Function IsClipboardFormatAvailable Lib "user32" (ByVal wFormat As Long) As Long
    Public Declare Function GetClipBoardData Lib "user32" Alias "GetClipboardData" (ByVal wFormat As Long) As Long
    Public Declare Function LoadString Lib "user32" Alias "LoadStringA" (ByVal hInstance As Long, ByVal uID As Long, ByVal lpBuffer As String, ByVal nBufferMax As Long) As Long
 
    Private pFormatDataCell As Long
#End If
 
 
Public Enum EPredefinedClipboardFormatConstants
    [_First] = 1
    CF_TEXT = 1
    CF_BITMAP = 2
    CF_METAFILEPICT = 3
    CF_SYLK = 4
    CF_DIF = 5
    CF_TIFF = 6
    CF_OEMTEXT = 7
    CF_DIB = 8
    CF_PALETTE = 9
    CF_PENDATA = 10
    CF_RIFF = 11
    CF_WAVE = 12
    CF_UNICODETEXT = 13
    CF_ENHMETAFILE = 14
    CF_HDROP = 15
    CF_LOCALE = 16
    CF_MAX = 17
    [_Last] = 17
End Enum
 
 
Const GHND = &H42
'Const CF_TEXT = 1
Const MAXSIZE = 4096
 
 
#If VBA7 Then
    Public Property Get CF_UserDataCell() As LongPtr
        'On crée/récupère le format DataCell
        Clipboard_RegisterFormat cst_XML_DataCell
    End Property
    Function Clipboard_RegisterFormat(FormatId As String) As LongPtr
        Dim lR As LongPtr
        Dim lSize As LongPtr
        Dim sBuf As String
        If FormatId <> "" Then
            Clipboard_RegisterFormat = RegisterClipboardFormat(FormatId)
        End If
    End Function
#Else
    Public Property Get CF_UserDataCell() As Long
        'On crée/récupère le format DataCell
        Clipboard_RegisterFormat cst_XML_DataCell
    End Property
    Function Clipboard_RegisterFormat(FormatId As String) As Long
        Dim lR As Long
        Dim lSize As Long
        Dim sBuf As String
        If FormatId <> "" Then
            Clipboard_RegisterFormat = RegisterClipboardFormat(FormatId)
        End If
    End Function
#End If
 
 
 
 
Function ClipBoard_GetData(Optional FormatId As String) As String
Dim MyString As String
#If VBA7 Then
    Dim hClipMemory As LongPtr
    Dim lpClipMemory As LongPtr
    Dim RetVal As LongPtr
    Dim hFormatId As LongPtr
#Else
    Dim hClipMemory As Long
    Dim lpClipMemory As Long
    Dim RetVal As Long
    Dim hFormatId As Long
#End If
 
    If FormatId <> "" Then
        hFormatId = Clipboard_RegisterFormat(FormatId)
    Else
        hFormatId = CF_TEXT
    End If
 
    If OpenClipboard(0&) = 0 Then
        MsgBox "Cannot open Clipboard. Another app. may have it open"
        Exit Function
    End If
 
    ' Obtain the handle to the global memory
    ' block that is referencing the text.
    hClipMemory = GetClipBoardData(hFormatId)
    If IsNull(hClipMemory) Then
        MsgBox "Could not allocate memory"
        GoTo OutOfHere
    End If
 
    ' Lock Clipboard memory so we can reference
    ' the actual data string.
    lpClipMemory = GlobalLock(hClipMemory)
 
    If Not IsNull(lpClipMemory) Then
        MyString = Space$(2 ^ 15)
        RetVal = lstrcpy(MyString, lpClipMemory)
        RetVal = GlobalUnlock(hClipMemory)
 
        ' Peel off the null terminating character.
        MyString = Trim(Left(MyString, Len(MyString) - 1))
    Else
        MsgBox "Could not lock memory to copy string from."
    End If
 
OutOfHere:
 
   RetVal = CloseClipboard()
   ClipBoard_GetData = MyString
 
End Function
 
 
Public Function ClipBoard_SetData(MyString As String, Optional FormatId As String) As Boolean '
'PURPOSE: API function to copy text to clipboard
'SOURCE: www.msdn.microsoft.com/en-us/library/office/ff192913.aspx
 
 
#If VBA7 Then
  Dim hGlobalMemory As LongPtr, lpGlobalMemory As LongPtr
  Dim hFormatId As LongPtr
#Else
  Dim hGlobalMemory As Long, lpGlobalMemory As Long
  Dim hFormatId As Long
#End If
 
 
    '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."
     Else
 
        '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.
        EmptyClipboard
 
        'On ajoute le format
        If FormatId <> "" Then
           hFormatId = RegisterClipboardFormat(FormatId)
        End If
        If hFormatId = 0 Then hFormatId = CF_TEXT
 
        'Copy the data to the Clipboard.
        ClipBoard_SetData = SetClipboardData(hFormatId, hGlobalMemory) <> 0
    End If
 
    If CloseClipboard() = 0 Then
        MsgBox "Could not close Clipboard."
    End If
 
 
End Function

Pour faire un test, tu peux utiliser ça

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
Public Sub CopyTextToClipboard()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
 
 
'Notify User
  MsgBox "There is now text copied to your clipboard!", vbInformation
 
 
End Sub

[/Edit]
++
Qwaz

[Kestion100]

PARFAIT!!!!!!

C'était quand même bien plus simple avant!!!!!!

[Tête de chat]

Bonjour,

effectivement c'est un bug qui est apparu avec Windows 10. Le fait qu'il y ait une listBox dans le paysage ne change rien.

Ferme Excel, ferme toutes les occurrences de ton explorateur de fichiers,, relance Excel et retente... mais bon ça n'est pas complétement satisfaisant !

Pourquoi ne pas simplement utiliser une cellule de travail dans un coin de ton classeur ?

Code :

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

1
2
MaCellule = ListBox2.List(ListBox2.ListIndex)
MaCellule .Copy

[Thumb down]

Bonjour,

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Public Function ClearPressePapier()
With CreateObject("htmlfile").parentwindow.clipboardData.clearData("Text"): End With
End Function
Public Property Let PressePapier(valeur)
With CreateObject("htmlfile").parentwindow.clipboardData.SetData("Text", valeur): End With
End Property
Public Property Get PressePapier()
PressePapier = CreateObject("htmlfile").parentwindow.clipboardData.GetData("TEXT")
End Property
 Sub test()
PressePapier = "TOTO"
Msgbox PressePapier
End sub

[Qwazerty]

Salut

C'est quoi l'intérêt des With... End With sur une ligne qui ne les utilise pas?

++
Qwaz

[Thumb down]

bonjour,
tu as raison on peut utiliser directement

Code :

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

1
2
3
4
5
6
7
8
9
Public  Sub ClearPressePapier()
CreateObject("htmlfile").parentwindow.clipboardData.clearData("Text")
End Sub
Public Property Let PressePapier(valeur)
 CreateObject("htmlfile").parentwindow.clipboardData.SetData("Text", valeur)
End Property
Public Property Get PressePapier()
PressePapier = CreateObject("htmlfile").parentwindow.clipboardData.GetData("TEXT")
End Property

[Kestion100]

Je pensais la chose réglé mais le problème persiste dans le cas d'adresse mails, l'@ pose-t-il problème?