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