XL 2010 Compatibilité 32 - 64 bits

mécano41

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

Code:
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
 

Pièces jointes

  • 427370d1607615621-calcul-excel-levage-d-une-passerelle-mecano41.jpg
    427370d1607615621-calcul-excel-levage-d-une-passerelle-mecano41.jpg
    92.6 KB · Affichages: 82

patricktoulon

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

mécano41

XLDnaute Accro
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
 
Dernière édition:

Discussions similaires