XL 2019 Probleme olepro32 et/ou LongPtr

carlos

XLDnaute Impliqué
Supporter XLD
Bonjour,
Je tourne sous VBA excel 64
Lorsque je veux importer une image sur mon USF j'ai l'errreur de" olepro32 qui n'est pas installée".
J'ai essayé de mettre Long en longPtr mais ca ne marche pas
. hPic As Longptr
hPal As Longptr
Voic mon code si quelqu'un peut ma'aider :
Option Explicit
Option Private Module
'!* 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 Ti (10/04)
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
#If VBA7 Then
Private Declare PtrSafe Function IsClipboardFormatAvailable& Lib "user32" (ByVal wFormat%)
Private Declare PtrSafe Function OpenClipboard& Lib "user32" (ByVal hwnd&)
Private Declare PtrSafe Function GetClipboardData& Lib "user32" (ByVal wFormat%)
Private Declare PtrSafe Function CloseClipboard& Lib "user32" ()
Private Declare PtrSafe Function OleCreatePictureIndirect& Lib "olepro32.dll" (PicDesc As uPicDesc, RefIID As GUID, ByVal fPictureOwnsHandle&, IPic As IPicture)
Private Declare PtrSafe Function CopyEnhMetaFile& Lib "gdi32" Alias "CopyEnhMetaFileA" (ByVal hemfSrc&, ByVal lpszFile$)
Private Declare PtrSafe Function CopyImage& Lib "user32" (ByVal Handle&, ByVal un1&, ByVal n1&, ByVal n2&, ByVal un2&)
#Else
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&)
#End If
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&, hPicAvail&
lPicType = IIf(lXlPicType = xlBitmap, CF_BITMAP, CF_ENHMETAFILE)
hPicAvail = IsClipboardFormatAvailable(lPicType)
If hPicAvail <> 0 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

XLDnaute Barbatruc
Bonjour
Lorsque je veux importer une image sur mon USF j'ai l'errreur de" olepro32 qui n'est pas installée".
question 1°
qu'a telle de si spéciale cette image pour que tu soit obligée d'aller chercher le module create picture de stephen bullen

déjà ceci me perturbe
je suis étonné que Mr Bullen ai fait cette erreur dans les déclarations 64
Private Declare PtrSafe Function OleCreatePictureIndirect& Lib "olepro32.dll" (PicDesc As uPicDesc, RefIID As GUID, ByVal fPictureOwnsHandle&, IPic As IPicture)

d'ailleurs toute les déclaration 64 sont fausses elle sont faites en vba 7 32 bits
je précise
"&" veut dire "As long" et pas "As LongPtr"

sans doute travaille t il en vba7 mais sur une version 32 comme moi d'ailleurs

mais j'insiste sur ma question 1
 

patricktoulon

XLDnaute Barbatruc
re
Bonjour @carlos
si ce n'est que ça j'ai deux solutions simple prêt à l'emploi pour toi
pas la peine d'aller chercher le pastepicture de stephen bullen
  1. méthode sans api avec un graphique
  2. méthode copie avec en metafichier
ces deux méthodes sont dans le fichier joint

2 userforms utilisant chacun une méthodes

fonction prêtes à l'emploi

démo méthode 1
demo.gif



démo méthode 2
demo.gif


;)
 

Pièces jointes

  • model pour carlos V patricktoulon.xlsm
    30.4 KB · Affichages: 2

carlos

XLDnaute Impliqué
Supporter XLD
J'ai testé sous "D:" & "\mon image.gif" et ca marche.
Donc ton fichier fonctionne parfaitement.
J'ai donc un probleme avec mon dossier ou est enregistré ce fichier car il reprend le chemin du drive "Http ..."et non celui du chemin local. Je ne sais pas pourquoi nia qui demandé de m'aider

En tout cas, merci Patricktoulon d'avoir pris le temps de me faire 2 exemples d'import.
Bonne journée
 

Statistiques des forums

Discussions
313 230
Messages
2 096 410
Membres
106 604
dernier inscrit
JulienMan