Bonjour à tous et à toutes,

J'ai un souci sur une instruction qui ne s’exécute pas.
Il n'y a pas d'erreur, juste que l’exécution "saute" sur l'instruction et revient sur la routine mère
Il s'agit d'un programme qui marche depuis des années; je soupçonne une mise à jour

Il s'agit de l'avant dernière instruction au niveau de "OleCreatePictureIndirect uPicInfo, IID_IDispatch, True, IPic"

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
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


à toutes fins utiles il y a des déclarations préalables

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
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
il s'agit d'une fonction utilisée dans un module qui a pour objectif de prendre des graphiques et les afficher dans une userform en passant par un format image


merci pour votre aide