XL 2016 VBA - Anomalie avec le presse-papiers

D

danielco

XLDnaute Accro
Bonjour,

J'ai ce code qui fonctionne en début de journée pour copier le contenu d'une cellule dans le presse-papiers :

VB: 
  Dim obj As New DataObject
  Dim txt As String
  obj.SetText Target.Value
  obj.PutInClipboard

Il n'y a pas d'erreur mais au lieu de la valeur de la cellule, le coller donne deux points d'interrogation encadrés.

Connaissez-vous ce problème et connaissez-vous un contournement ?

Merci d'avance.

Daniel
 
Trier par date Trier par votes
Dudu2

Dudu2

XLDnaute Barbatruc
Bonjour,

VB: 
Sub a()
    Call b([A1])
End Sub

Sub b(Target As Range)
    Dim Clipboard As Object
  
    'DataObject en late binding
    Set Clipboard = CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
  
    With Clipboard
        .SetText CStr(Target.Value)
        .PutInClipBoard
    End With
End Sub
 
Dernière édition:
Vote positif 0 Vote négatif
Dranreb

Dranreb

XLDnaute Barbatruc
Bonjour.
Ça m'arrive aussi quelquefois qu'un DataObject cesse subitement d'être opérationnel. Impossible de trouver quelle mystérieuse manœuvre fusille sa capacité à fonctionner. Ce code, par contre beaucoup plus abscons, a l'air plus fiable :
VB: 
Option Explicit
Private Declare Function OpenClipboard Lib "user32.dll" (ByVal hWnd As Long) As Long
Private Declare Function EmptyClipboard Lib "user32.dll" () As Long
Private Declare Function CloseClipboard Lib "user32.dll" () As Long
Private Declare Function IsClipboardFormatAvailable Lib "user32.dll" (ByVal wFormat As Long) As Long
Private Declare Function GetClipboardData Lib "user32.dll" (ByVal wFormat As Long) As Long
Private Declare Function SetClipboardData Lib "user32.dll" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Private Declare Function GlobalAlloc Lib "kernel32.dll" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalLock Lib "kernel32.dll" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32.dll" (ByVal hMem As Long) As Long
Private Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function lstrcpy Lib "kernel32.dll" Alias "lstrcpyW" (ByVal lpString1 As Long, ByVal lpString2 As Long) As Long
Public Property Let PressePapier(ByVal sUniText As String)
   Dim iStrPtr As Long
   Dim iLen As Long
   Dim iLock As Long
   Const GMEM_MOVEABLE As Long = &H2
   Const GMEM_ZEROINIT As Long = &H40
   Const CF_UNICODETEXT As Long = &HD
   OpenClipboard 0&
   EmptyClipboard
   iLen = LenB(sUniText) + 2&
   iStrPtr = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, iLen)
   iLock = GlobalLock(iStrPtr)
   lstrcpy iLock, StrPtr(sUniText)
   GlobalUnlock iStrPtr
   SetClipboardData CF_UNICODETEXT, iStrPtr
   CloseClipboard
   End Property
Public Property Get PressePapier() As String
   Dim iStrPtr As Long
   Dim iLen As Long
   Dim iLock As Long
   Dim sUniText As String
   Const CF_UNICODETEXT As Long = 13&
   OpenClipboard 0&
   If IsClipboardFormatAvailable(CF_UNICODETEXT) Then
      iStrPtr = GetClipboardData(CF_UNICODETEXT)
      If iStrPtr Then
         iLock = GlobalLock(iStrPtr)
         iLen = GlobalSize(iStrPtr)
         sUniText = String$(iLen \ 2& - 1&, vbNullChar)
         lstrcpy StrPtr(sUniText), iLock
         GlobalUnlock iStrPtr
         End If
      PressePapier = sUniText
      End If
   CloseClipboard
   End Property
Pour copier faire PressePapier = expression String,
pour coller: Variabe ou propriété String = PressePapier
 
Vote positif 0 Vote négatif
patricktoulon

patricktoulon

XLDnaute Barbatruc
Bonjour à tous
methode patricktoulon
VB: 
'------------------------------------------------
'clipboard(IN/OUT)patricktoulon
'------------------------------------------------
Public Property Get PressePapier() As String
    On Error Resume Next
    PressePapier = Replace(Replace(CreateObject("htmlfile").parentwindow.clipboardData.GetData("TEXT"), "<html>", ""), "</html>", "")
End Property

Public Property Let PressePapier(ByVal valeur As String)
    CreateObject("htmlfile").parentwindow.clipboardData.setData "TEXT", "<html> " & valeur & "</html>"
End Property

Sub VidePressePapier()
    With CreateObject("htmlfile").parentwindow.clipboardData.clearData("Text"): End With
End Sub
'---------------------------------------------------------------------------------------

'on met dans le presspapier
Sub ecrire_dans_le_clipbord()
    PressePapier = "on met du text dans le clip bord blablabla"
End Sub

'on lit le presspapier
Sub lire_le_clipboard()
    MsgBox PressePapier
End Sub

'on vide le pressepapier
Sub test_vide_le_presse_papier()
    VidePressePapier
End Sub

'on copie une plage et on lit le contenu
Sub test_copy_cell_et_lecture_directe()
    [A3:A4].Copy
    MsgBox PressePapier
    Application.CutCopyMode = False
End Sub

fonctionne même en ayant copié quelque chose ailleurs que sur excel

une plage de cellules copiées est restituée sous forme de texte et les valeurs par colonnes sont séparées par un caractère Tab

uniquement Windows bien sur!!!
pour MAC il faut se débrouiller avec le dataobject
 
Vote positif 0 Vote négatif
D

danielco

XLDnaute Accro
Dranreb à dit:
Bonjour.
Ça m'arrive aussi quelquefois qu'un DataObject cesse subitement d'être opérationnel. Impossible de trouver quelle mystérieuse manœuvre fusille sa capacité à fonctionner. Ce code, par contre beaucoup plus abscons, a l'air plus fiable :
VB: 
Option Explicit
Private Declare Function OpenClipboard Lib "user32.dll" (ByVal hWnd As Long) As Long
Private Declare Function EmptyClipboard Lib "user32.dll" () As Long
Private Declare Function CloseClipboard Lib "user32.dll" () As Long
Private Declare Function IsClipboardFormatAvailable Lib "user32.dll" (ByVal wFormat As Long) As Long
Private Declare Function GetClipboardData Lib "user32.dll" (ByVal wFormat As Long) As Long
Private Declare Function SetClipboardData Lib "user32.dll" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Private Declare Function GlobalAlloc Lib "kernel32.dll" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalLock Lib "kernel32.dll" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32.dll" (ByVal hMem As Long) As Long
Private Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function lstrcpy Lib "kernel32.dll" Alias "lstrcpyW" (ByVal lpString1 As Long, ByVal lpString2 As Long) As Long
Public Property Let PressePapier(ByVal sUniText As String)
   Dim iStrPtr As Long
   Dim iLen As Long
   Dim iLock As Long
   Const GMEM_MOVEABLE As Long = &H2
   Const GMEM_ZEROINIT As Long = &H40
   Const CF_UNICODETEXT As Long = &HD
   OpenClipboard 0&
   EmptyClipboard
   iLen = LenB(sUniText) + 2&
   iStrPtr = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, iLen)
   iLock = GlobalLock(iStrPtr)
   lstrcpy iLock, StrPtr(sUniText)
   GlobalUnlock iStrPtr
   SetClipboardData CF_UNICODETEXT, iStrPtr
   CloseClipboard
   End Property
Public Property Get PressePapier() As String
   Dim iStrPtr As Long
   Dim iLen As Long
   Dim iLock As Long
   Dim sUniText As String
   Const CF_UNICODETEXT As Long = 13&
   OpenClipboard 0&
   If IsClipboardFormatAvailable(CF_UNICODETEXT) Then
      iStrPtr = GetClipboardData(CF_UNICODETEXT)
      If iStrPtr Then
         iLock = GlobalLock(iStrPtr)
         iLen = GlobalSize(iStrPtr)
         sUniText = String$(iLen \ 2& - 1&, vbNullChar)
         lstrcpy StrPtr(sUniText), iLock
         GlobalUnlock iStrPtr
         End If
      PressePapier = sUniText
      End If
   CloseClipboard
   End Property
Pour copier faire PressePapier = expression String,
pour coller: Variabe ou propriété String = PressePapier
Cliquez pour agrandir...
Je vais tester ton code qui semble faire un vidage du presse-papiers. Je ne peux l'esssayer que lorsque le problème se produira. Je te tiens au courant.
Daniel
 
Vote positif 0 Vote négatif
D

danielco

XLDnaute Accro
patricktoulon à dit:
Bonjour à tous
methode patricktoulon
VB: 
'------------------------------------------------
'clipboard(IN/OUT)patricktoulon
'------------------------------------------------
Public Property Get PressePapier() As String
    On Error Resume Next
    PressePapier = Replace(Replace(CreateObject("htmlfile").parentwindow.clipboardData.GetData("TEXT"), "<html>", ""), "</html>", "")
End Property

Public Property Let PressePapier(ByVal valeur As String)
    CreateObject("htmlfile").parentwindow.clipboardData.setData "TEXT", "<html> " & valeur & "</html>"
End Property

Sub VidePressePapier()
    With CreateObject("htmlfile").parentwindow.clipboardData.clearData("Text"): End With
End Sub
'---------------------------------------------------------------------------------------

'on met dans le presspapier
Sub ecrire_dans_le_clipbord()
    PressePapier = "on met du text dans le clip bord blablabla"
End Sub

'on lit le presspapier
Sub lire_le_clipboard()
    MsgBox PressePapier
End Sub

'on vide le pressepapier
Sub test_vide_le_presse_papier()
    VidePressePapier
End Sub

'on copie une plage et on lit le contenu
Sub test_copy_cell_et_lecture_directe()
    [A3:A4].Copy
    MsgBox PressePapier
    Application.CutCopyMode = False
End Sub

fonctionne même en ayant copié quelque chose ailleurs que sur excel

une plage de cellules copiées est restituée sous forme de texte et les valeurs par colonnes sont séparées par un caractère Tab

uniquement Windows bien sur!!!
pour MAC il faut se débrouiller avec le dataobject
Cliquez pour agrandir...
Bonjour Patrick et merci. Je vais tester ta solution dès que le problème se sera reproduit.
Daniel
 
Vote positif 0 Vote négatif
D

danielco

XLDnaute Accro
Vote positif 0 Vote négatif
Dudu2

Dudu2

XLDnaute Barbatruc
En effet, ça vaut la peine d'essayer car le mystère de perte de fonctionnalité qu'évoque @Dranreb avec la Microsoft Forms 2.0 Object Library (C:\Windows\SysWOW64\FM20.DLL) pourrait peut-être disparaître avec ce "late binding".
En tous cas ce serait intéressant de le savoir.
 
Vote positif 0 Vote négatif
Dudu2

Dudu2

XLDnaute Barbatruc
Et le fait de ne pas qualifier complètement le DataObject ?
Dim obj As New DataObject versus Dim obj As New MSForms.DataObject

D'ailleurs ce serait plus prudent de faire obj.SetText CStr(Target.Value).
 
Dernière édition:
Vote positif 0 Vote négatif
Dranreb

Dranreb

XLDnaute Barbatruc
Oui, ça pourrait être piégeant, car j'ai déjà vu d'autres bibliothèques définissant aussi un DataObject qui n'a pas l'air pareil. Mais je ne crois pas que ce soit la source du problème, sinon ça ne fonctionnerait jamais et pas durant un certain temps jusqu'à une mystérieuse circonstance.
 
Vote positif 0 Vote négatif

Discussions similaires

D
  • Question
XL 2016 VBA - Problème avec le coper-coller
Réponses
12
Affichages
932
danielco
D
E
  • Question
XL 2010 problème macro qui désactive le pavé numérique
2
Réponses
18
Affichages
597
Dranreb
Dranreb
LUMBARDO
  • Question
Microsoft 365 Pb avec Windows
2 3 4
Réponses
47
Affichages
2 K
LUMBARDO
LUMBARDO
J
  • Question
XL 2019 PB de copier de valeur dans le presse papier
Réponses
6
Affichages
1 K
JPaul78
J
L
  • Question
Autres Copier des données d’un fichier sans l’ouvrir juste en le sélectionnant via un UserForm
Réponses
6
Affichages
415
Liner77
L
C
  • Question
Microsoft 365 Copier des données d'un fichier excel sur un fichier word
Réponses
0
Affichages
746
ChristianJ
C
H
  • Résolu(e)
XL 2019 récupérer une donnée d'un fichier csv pour le copier vers un autre
2
Réponses
27
Affichages
1 K
Hutchy33
H
B
  • Question
Microsoft 365 Envoyer des informations dans le presse papiers windows 10
Réponses
7
Affichages
715
patricktoulon
patricktoulon
G
  • Résolu(e)
Microsoft 365 Faire une collection de collection en VBA
2
Réponses
25
Affichages
1 K
dysorthographie
dysorthographie
My<3
  • Résolu(e)
XL 2019 erreur avec loop de formule vba
Réponses
5
Affichages
491
TooFatBoy
TooFatBoy

Membres actuellement en ligne

12 membres et 94 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 209
Messages
2 086 274
Membres
103 168
dernier inscrit
isidore33