XL 2016 VBA - Anomalie avec le presse-papiers

danielco · 11 Août 2021

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

danielco · 13 Août 2021

Dudu2 à dit:
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).

J'en prends note également, merci.

Daniel

danielco · 13 Août 2021

Dudu2 à dit:

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

Bonjour @Dudu2 et merci.
Désolé, ça ne fonctionne pas.
Daniel

danielco · 13 Août 2021

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

Bonjour @Dranreb
Ca fonctionne ! Merci.
Daniel

danielco · 13 Août 2021

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

Bonjour @patricktoulon
Ca fonctionne bien. Juste une curiosité, si je colle dans Excel, j'obtiens un résultat en Calibri 10 alors que j'ai double-cliqué sur une cellule en Calibri 11. Comme le Coller ne se fera pas dans Office, ça ne me gêne en aucun cas.
Merci.
Daniel

danielco · 13 Août 2021

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

Désolé, jai ENCORE oublié comment on marque une discussion comme résolue. Peux-tu me l'indiquer ?

patricktoulon · 13 Août 2021

re
Bonjour @DANIELO
ben c'est normal on copie du texte là pas son format
et calibri 11 c'est le format par defaut dans les cellules excel
et de toute facon c'est pareil avec le dataobject

danielco · 13 Août 2021

patricktoulon à dit:
re
Bonjour @DANIELO
ben c'est normal on copie du texte là pas son format
et calibri 11 c'est le format par defaut dans les cellules excel
et de toute facon c'est pareil avec le dataobject

Je me suis mal exprimé. La cellule copiée est en Calibri 11 et le résultat du coller est en Calibri 10. De toute façon, aucune importance. Le coller ne se fera pas dans Office.

patricktoulon · 13 Août 2021

re
et moi visiblement je nai pas été assez clair
donc !
non ce n'est pas du texte en calibri 10 qui est collé c'est du texte c'est tout
si c'est en 10 c'est par ce que le support dans le quel tu colle est en 10 par défaut (voir même volontaire)

danielco · 13 Août 2021

patricktoulon à dit:
re
et moi visiblement je nai pas été assez clair
donc !
non ce n'est pas du texte en calibri 10 qui est collé c'est du texte c'est tout
si c'est en 10 c'est par ce que le support dans le quel tu colle est en 10 par défaut (voir même volontaire)

Désolé de te contredire. Il est exact que c'est pareil avec le dataobject. C'est bizarre :

Daniel

patricktoulon · 13 Août 2021

si ca se modifie quelque part chez toi c'est que tu fait quelque chose qui faut pas
chez moi sur 2013 et 2007 c'est c'est 11 partout avant apres pendant et meme plus tard 🤣

Dudu2 · 13 Août 2021

Bonjour,

Je ne comprends pas ta remarque @Dranreb.
C'est du pur texte sans format qui est copié.

patricktoulon · 13 Août 2021

Bonjour @Dudu2
c'est ce que j'essaie d'expliquer a @danielco
il est impossible que du texte copié ou que se soit et coller en tant que texte dans une cellule ai un format différent du format(tout compris) par defaut de excel
SAUF!!!!!!!!!!!!!!!!
copie html là c'est différent la restitution est légèrement différente ,mais là on parle de copy/paste directe sans passer par le dataobject ou autre
et ce phénomène excel/html est valable dans les deux sens html To excel et vice et versa
pour la simple raison que excel a sa propre échelle graphique

Dudu2 · 13 Août 2021

Comme le Coller ne se fera pas dans Office

Si le Coller le se fait pas dans Office, peut-être qu'un simple Target.Copy suffit.
La destination en fera un Coller sans format implicitement. Au risque il est vrai de se coltiner le Line Feed terminal.

Dranreb · 13 Août 2021

Bonjour.

Dudu2 à dit:
Je ne comprends pas ta remarque @Dranreb.

Je n'ai quant à moi émis aucune remarque à ce sujet.

Dudu2 · 13 Août 2021

Bonjour @Dudu2 et merci.
Désolé, ça ne fonctionne pas.

Je suis surpris que ton diagnostic soit si rapide et direct.
J'utilise cette méthode MSForms dans un fichier de banque depuis des années et je n'ai jamais rencontré de problème.
Loin de moi l'idée de défendre cette méthode mais ça me surprend que tu arrives à la planter immédiatement. Mais bon, je veux bien te croire 😉

C'est quoi l'erreur qui se produit ?

XL 2016 VBA - Anomalie avec le presse-papiers

danielco

XLDnaute Barbatruc

danielco

XLDnaute Barbatruc

danielco

XLDnaute Barbatruc

danielco

XLDnaute Barbatruc

danielco

XLDnaute Barbatruc

danielco

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

danielco

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

danielco

XLDnaute Barbatruc

Pièces jointes

patricktoulon

XLDnaute Barbatruc

Dudu2

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Dudu2

XLDnaute Barbatruc

Dranreb

XLDnaute Barbatruc

Dudu2

XLDnaute Barbatruc

Discussions similaires

XL 2016 VBA - Anomalie avec le presse-papiers

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

Discussions similaires

Privacy & Transparency

Privacy & Transparency