XL 2016 VBA - Anomalie avec le presse-papiers

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
 

danielco

XLDnaute Accro
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

XLDnaute Accro
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

XLDnaute Accro
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 ?
 

danielco

XLDnaute Accro
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.
 

danielco

XLDnaute Accro
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 :

copier.PNG

coller.PNG


Daniel
 

Pièces jointes

  • copier.PNG
    copier.PNG
    4.9 KB · Affichages: 11

patricktoulon

XLDnaute Barbatruc
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

XLDnaute Barbatruc
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 ?
 

Discussions similaires

Réponses
47
Affichages
2 K

Statistiques des forums

Discussions
312 207
Messages
2 086 238
Membres
103 162
dernier inscrit
fcfg