XL 2010 Compatibilité 32 - 64 bits

[mécano41]

Bonjour,

J'ai récupéré ce code qui a bien fonctionné jusqu'à présent. Mon ordi est en 64 bits mais ma version EXCEL (2010) est en 32 bits. Je viens de passer à quelqu'un un fichier contenant ce code, et il a le problème indiqué ci-dessous. Que puis-je modifier pour faire une seconde fonction qui fonctionne en 64 bits? Ensuite, comment faire pour que l'appli. choisisse entre les deux fonction?

(tout ceci sachant que je ne pourrai pas faire les essais en 64 bits moi-même)

Si nécessaire, je pourrai poster l'appli...

Cordialement

Le code complet :

Option Explicit

'-============= Code récupéré sur ExcelDownloads ============
' 14/11/2012
' myDearFriend!  -   www.mdf-xlpages.com
'---------------------------------------------------------------------------------------
'!* MODULE NAME:     Paste Picture
'!* AUTHOR & DATE:   STEPHEN BULLEN, Business Modelling Solutions Ltd.
'!*                  15 November 1998
'!* CONTACT:         Stephen@BMSLtd.co.uk
'!* WEB SITE:        http://www.BMSLtd.co.uk
'
'! un peu modifié par Thierry Pourtier (Ti) oct 2004
'---------------------------------------------------------------------------------------
Private Type GUID
  Data1 As Long
  Data2 As Integer
  Data3 As Integer
  Data4(0 To 7) As Byte
End Type

' -----
Private Type uPicDesc
  Size As Long
  Type As Long
  hPic As Long
  hPal As Long
End Type

' -----
Private Declare Function IsClipboardFormatAvailable& Lib "user32" (ByVal wFormat&)
Private Declare Function OpenClipboard& Lib "user32" (ByVal hWnd&)
Private Declare Function GetClipboardData& Lib "user32" (ByVal wFormat%)
Private Declare Function CloseClipboard& Lib "user32" ()
Private Declare Function OleCreatePictureIndirect& Lib "olepro32.dll" (PicDesc As uPicDesc, RefIID As GUID, ByVal fPictureOwnsHandle&, IPic As IPicture)
Private Declare Function CopyEnhMetaFile& Lib "gdi32" Alias "CopyEnhMetaFileA" (ByVal hemfSrc&, ByVal lpszFile$)
Private Declare Function CopyImage& Lib "user32" (ByVal handle&, ByVal un1&, ByVal n1&, ByVal n2&, ByVal un2&)

Const CF_BITMAP = 2, CF_PALETTE = 9, CF_ENHMETAFILE = 14
Const IMAGE_BITMAP = 0, LR_COPYRETURNORG = &H4
Const PICTYPE_BITMAP = 1, PICTYPE_ENHMETAFILE = 4

' -----
Private Function CreatePicture(hPic&, hPal&, lPicType&) As IPicture
Dim uPicInfo As uPicDesc, IID_IDispatch As GUID, IPic As IPicture
  With IID_IDispatch
    .Data1 = &H7BF80980
    .Data2 = &HBF32
    .Data3 = &H101A
    .Data4(0) = &H8B
    .Data4(1) = &HBB
    .Data4(2) = &H0
    .Data4(3) = &HAA
    .Data4(4) = &H0
    .Data4(5) = &H30
    .Data4(6) = &HC
    .Data4(7) = &HAB
  End With
  With uPicInfo
    .Size = Len(uPicInfo)
    .Type = IIf(lPicType = CF_BITMAP, PICTYPE_BITMAP, PICTYPE_ENHMETAFILE)
    .hPic = hPic
    .hPal = IIf(lPicType = CF_BITMAP, hPal, 0)
  End With
  OleCreatePictureIndirect uPicInfo, IID_IDispatch, True, IPic
  Set CreatePicture = IPic
End Function

' -----
Function PastePicture(Optional lXlPicType& = xlPicture) As IPicture
Dim hPtr&, lPicType&, hCopy&
  lPicType = IIf(lXlPicType = xlBitmap, CF_BITMAP, CF_ENHMETAFILE)
  
  If IsClipboardFormatAvailable(lPicType) Then
    If OpenClipboard(0&) > 0 Then
      hPtr = GetClipboardData(lPicType)
      If lPicType = CF_BITMAP Then
        hCopy = CopyImage(hPtr, IMAGE_BITMAP, 0, 0, LR_COPYRETURNORG)
      Else
        hCopy = CopyEnhMetaFile(hPtr, vbNullString)
      End If
      CloseClipboard
      If hPtr <> 0 Then Set PastePicture = CreatePicture(hCopy, 0, lPicType)
    End If
  End If
End Function

 

[patricktoulon]

perso j'ai eu 2010 pendant pas longtemps(il a bien d'autre défauts plus grave) et j'ai jamais eu de soucis avec les api clipboard et gdi
je penche plutôt pour un accès bloqué du clipboard

je te prepare un autre essai (une autre méthode)tu me dira

 

[Staple1600]

Re

=>patricktoulon
Tu as été lire le lien que j'ai mis?
(cf message#30)

 

[patricktoulon]

oui Staple1600 je suis allé voir
je suis pas sur que la traduction mais traduit correctement parce que je n'ai pas trouvé le rapport avec le sujet

ici il s'agit de copier les images de la 2d feuille dans les frames du userform
comme je l'ai dis 2007 ,2010,2013,2016 ça tourne

 

[Staple1600]

Re

Je suis sous W10 64 bits et je ne peux correctement utilisé le clipboard en VBA comme expliqué dans le lien que j'ai mis.

 

[patricktoulon]

a bon
ma fois je ne lui proposerais pas ma version courte en wmf alors
il ne lui reste plus que le graph exporté si tant est que l'image se colle dans le graph sinon ben il oublie

 

[Staple1600]

Re

La c'est plus explicite, non ?

Clipboard copy VBA code not working in Windows 10

Dear All, While working in Windows 7 this code was working in Excel 2013 But this same code is not working in Windows 10 and returns ASCI code ?? Interesting fact is if 2 more windows explorer (folders) are open this error appears If the windows explorer (folders) are closed this same code is...

chandoo.org

 

[mécano41]

Désolé de vous mobiliser sur mon problème...

J'utilisais cette méthode pour ne pas avoir les images dans un autre endroit mais je viens d'essayer la méthode qui consiste à mettre le nom du fichier image dans les propriétés de la frame qui doit la recevoir ; je pensais que le code devait recharger l'image à chaque ouverture de l'Userform et donc que l'image devait être disponible en permanence dans le répertoire de l'appli.. Apparemment il n'en est rien, j'ai supprimé les fichiers de ces images et tout fonctionne. Sauf erreur, l'image semble donc implantée définitivement.

Pouvez-vous me confirmer que cela ne posera pas de problème ultérieurement? (reste à voir chez mon correspondant...)

EDIT : le dessin obtenu est très moche...(bitmap)

Cordialement