Discussion :

[Gorzyne]

Bonjour à tous,

je développe un logiciel depuis quelques années dans lequel j'affiche à un moment dans une userform quelques graphiques type piechart

donc je suis parti sur une méthode librairie User32 - gdi32 - olepro32.dll je mets le code plus bas (partiellement offusqué dsl)

le souci c'est que je suis passé sur une nouvelle version sur un de mes ordinateurs de travail, Office 2019, et les graphiques ne s'affichent plus



donc je m'inquiète un peu pour la compatibilité à venir, même si je ne pense pas que tout le monde passe à Office 2019 sur le champ
si vous avez des éléments de compréhension, cela serait très séduisant

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
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
 
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
 
Sub abababaabbaaabb(aabababababaa)
    erk = 0
    On Error GoTo boucle0
    Dim Img As Shape
    Dim Grph As Chart
    Dim Curve As Worksheet
    Set Curve = ThisWorkbook.Sheets("MYTCD")
 
    If aabababababaa <> 4 And aabababababaa <> 5 Then
        Set Grph = Curve.ChartObjects(aabababababaa).Chart
    ElseIf aabababababaa = 4 Then
        Set Grph = Sheets("Simulation").ChartObjects(2).Chart
    ElseIf aabababababaa = 5 Then
        Set Grph = Sheets("Simulation").ChartObjects(1).Chart
    End If
 
    Grph.CopyPicture
    ThisWorkbook.Activate
    Sheets("Graphiques").Activate
    Sheets("Graphiques").Paste
    Call waittime
    On Error Resume Next
    Set Img = Sheets("Graphiques").Shapes(aabababababaa)
 
    On Error GoTo 0
 
    If Not Img Is Nothing Then
 
        Img.CopyPicture xlScreen, xlPicture
 
        Select Case aabababababaa
            Case 1
            Set Graphs.Image1.Picture = babababababaa()
            Case 4
            Set Graphs.Image2.Picture = babababababaa()
            Case 2
            Set Graphs.Image3.Picture = babababababaa()
            Case 3
            Set Graphs.Image4.Picture = babababababaa()
            Case 5
            Set Graphs.Image5.Picture = babababababaa()
        End Select
 
    End If
 
    Set Grph = Nothing
 
    Exit Sub
boucle0:
 
    If erk < 10 Then
        Debug.Print "Erreur 0." & erk
        Grph.CopyPicture
        Resume Next
    End If
End Sub
 
Function babababababaa(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 babababababaa = CreatePicture(hCopy, 0, lPicType)
    End If
  End If
End Function
 
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

[Pierre Fauconnier]

Salut.

C'est con, peut-être le problème était-il dans le code "offusqué" (sic)... Mais bon, si tu ne veux pas partager ton code qui vaut probablement des millions, tu comprendras qu'on ne soit pas trop enclins à partager nos éventuelles solutions.


Cela dit, utiliser des graphs dans des userforms avec un logiciel comme Excel qui en propose une kyrielle en natif, c'est... comment dire...

[Gorzyne]

c'est à dire que le code ne vaut sans doute pas des millions (peut être cent mille à la louche) mais c'est juste que ce n'est pas MON code mais DU code dont je suis peut être l'auteur mais pas le propriétaire
si ça ne tenait qu'à moins je n'aurai pas de scrupules à le partager d'ailleurs c'est ce que je j'ai fait dans le cas de figure qui nous préoccupe vu que j'ai posté l'entièreté de la macro qui gère l'affichage dans la Usf
je note la piste de l'offuscation, bien que normalement elle soit gérée proprement et preuve en est que le code tourne sur plateforme historique, et que bug apparaît suite à changement d'environnement
j'essaierai sur code défusqué mais je vois pas trop ce que ça pourrait changer

[Pierre Fauconnier]

Ca ne répond pas à la question fondamentale qui est : Pourquoi créer des graphiques par GDI dans Excel? Tant qu'à faire, recrée tes feuilles de calcul avec des listbox dans le userform et réinvente les formules qui vont avec... Ca n'a pour moi aucun sens!

Ton code utilise plein d'api 32 bits... si ton XL2019 est en 64 bits, ça risque déjà de poser des problèmes. Il existe des possibilités de rendre le code compatible, notamment avec les ptrSafe pour les pointeurs mémoire. Mais baser une "application Excel" sur des api 32 alors qu'Excel a tout ce qu'il faut en natif, c'est sûrement comique, mais clairement pas professionnel. Les problèmes viennent donc probablement moins du code, obfusqué ou pas, que des api 32 bits.

[Gorzyne]

normalement c'est géré par un switch en entête de module

#if VBA7
declare ptrsafe ...
#else
declare...
#end

mais il y a peut être une question, de 64bits quand même

[Gorzyne]

recrée tes feuilles de calcul avec des listbox dans le userform et réinvente les formules qui vont avec

du coup j'ai pas compris si c'était la vraie solution ou une plaisanterie ?
est ce qu'il y aurait une solution du coup ?

[Pierre Fauconnier]

du coup j'ai pas compris si c'était la vraie solution ou une plaisanterie ?
est ce qu'il y aurait une solution du coup ?

Ce n'est pas une plaisanterie. Je ne comprends pas pourquoi réinventer des piecharts dans des userforms Excel alors qu'Excel les gère en natif et est très bien outillé pour créer des graphiques de tous types. Je répète donc ce que j'ai déjà dit plus haut dans la discussion: Ca n'a aucun sens de créer des piecharts dans des userforms sur Excel. C'est un non-sens total.

Code "obfusqué" + graphiques reconstruits dans des userforms = Petit malin qui essaie de se la péter... Voilà mon impression de la chose

[Gorzyne]

c'est pas tout à fait ça mais il y a un peu de ça en effet
le "client" aime bien les petites fenêtres qui contiennent des graphiques ont lui pond des petites fenêtres qui contiennent des graphiques.
suite au passage en 64bits, les petits graphiques s'affichent plus, c'est pas grave on y passe deux heures pour trouver une autre façon de faire;
et on la trouve parce qu'on finit toujours par trouver


ce n'est pas la première fois que les MAJ windows ou office mettent par terre plein de programmes, et on a l'habitude on répare derrière