XL 2016 VBA - Anomalie avec le presse-papiers

  • Initiateur de la discussion Initiateur de la discussion danielco
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

danielco

XLDnaute Barbatruc
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
 
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:
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
 
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
 
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
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
 
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
Bonjour Patrick et merci. Je vais tester ta solution dès que le problème se sera reproduit.
Daniel
 
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.
 
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:
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.
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

  • Question Question
Microsoft 365 Pb avec Windows
Réponses
47
Affichages
3 K
Retour