Discussion :

[patrick pourmonet]

Bonjour,
je fais des extractions d'une base acces au format PDF que j'envoi par Email
j'utilise "MSCHART" (MSCHRT20.ocx) afin de réaliser des graphismes (extraction de données acces) et ça fonctionne fort bien.
Parallèlement j'utilise "mjwPDF" pour créer les fichiers PDF des extractions et ça fonctionne fort bien (pour les textes).
Le problème est le suivant, impossible de sauvegarder les fichiers "MSCHART" autrement qu'en BMP alors que "mjwPDF" n'accepte que des fichiers Jpeg.
Je peux copier le "MSCHART" dans le clipboard, mais je n'arrive pas à faire un transfert dans "mjwPDF"

Quelqu'un a t'il une idée pour me sortir de cette impasse.
j'oubliais, je travaille (encore...) en VB6 et la fonction est automatique, ce qui exclu l’utilisation manuel d'un logiciel de dessin pour transformer l'image.

Merci d'avance pour votre aide.
Patrick

[ProgElecT]

Salut patrick pourmonet , bienvenue sur DVP

Le code qui suit permet de créer un fichier (temporaire) au format JPG.
Sur un Form, 1 MSChart, un PictureBox et 1 CommandButton

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
Option Explicit
'si il n'est pas fait référence à Microsoft Windows Image Acquisition Library v2.0, WIAAut.dll
Private Type FormatImg
 'wiaFormatBMP As String
 'wiaFormatGIF As String
 wiaFormatJPEG As String
 'wiaFormatPNG As String
 'wiaFormatTIFF As String
End Type
Dim TpImg As FormatImg
Private Sub Form_Load()
'si il n'est pas fait référence à Microsoft Windows Image Acquisition Library v2.0, WIAAut.dll
 'TpImg.wiaFormatBMP = "{B96B3CAB-0728-11D3-9D7B-0000F81EF32E}"
 'TpImg.wiaFormatGIF = "{B96B3CB0-0728-11D3-9D7B-0000F81EF32E}"
 TpImg.wiaFormatJPEG = "{B96B3CAE-0728-11D3-9D7B-0000F81EF32E}"
 'TpImg.wiaFormatPNG = "{B96B3CAF-0728-11D3-9D7B-0000F81EF32E}"
 'TpImg.wiaFormatTIFF = "{B96B3CB1-0728-11D3-9D7B-0000F81EF32E}"
End Sub
 
Private Sub Command1_Click()
MSChart1.EditCopy
Picture1.Picture = Clipboard.GetData
SavePicture Picture1.Picture, App.Path & "\ImgTempo.bmp"
 
'adaptation du tuto de
'http://silkyroad.developpez.com/VBA/WindowsImageAcquisition/
'Il n'est pas besoin de faire référence à Microsoft Windows Image Acquisition Library v2.0, WIAAut.dll
 
    Dim Img1 As Object
    Dim IP 'As ImageProcess
 
    'Création conteneur pour l'image à manipuler
    Set Img1 = CreateObject("WIA.ImageFile")
 
    'Chargement de l'image dans le conteneur
    Img1.LoadFile (App.Path & "\ImgTempo.bmp")
    'Création du gestionnaire de filtre
    Set IP = CreateObject("WIA.ImageProcess")
    Dim AuFormat As String
    AuFormat = TpImg.wiaFormatJPEG
    IP.Filters.Add IP.FilterInfos("Convert").FilterID
    IP.Filters(1).Properties("FormatID").Value = AuFormat
    IP.Filters(1).Properties("Quality").Value = 100
 
    Set Img1 = IP.Apply(Img1)
 
    'sauvegarde de la nouvelle image en .jpg
    Img1.SaveFile (App.Path & "\ImgTempo.jpg")
    'supprime le fichier temporaire .bmp
    Kill App.Path & "\ImgTempo.bmp"
    'code pour inclure dans le pdf
    '...........
    'quand le pdf est OK
    'supprime le fichier temporaire .jpg
    'Kill App.Path & "\ImgTempo.jpg"
 
End Sub

[patrick pourmonet]

Bonjour,
c'est bon, ça marche très bien. Sauf un petit problème sur la fonction :

MSChart1.EditCopy
Picture1.Picture = Clipboard.GetData

la légende du graphique MSChart disparait lors de la copie et est remplacée par les valeurs de base (C1,C2...)
la modification s'opère bizarrement entre le copier et le coller de la fonction.

ça te dis quelque chose ?

Merci du coup de main
patrick

[ProgElecT]

Salut

Peut être une solution, pas beaucoup de changement, mais là on fait une copie de l'image du MSChart avec l'API BitBlt

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
Option Explicit
'-------------------------Nouveauté--------------------------------------
Private Declare Function GetDC Lib "USER32" (ByVal hwnd As Long) As Long
Private Declare Function BitBlt Lib "gdi32" ( _
    ByVal hDestDC As Long, _
    ByVal x As Long, _
    ByVal y As Long, _
    ByVal nWidth As Long, _
    ByVal nHeight As Long, _
    ByVal hSrcDC As Long, _
    ByVal xSrc As Long, _
    ByVal ySrc As Long, _
    ByVal dwRop As Long) As Long
'-------------------------Fin nouveauté--------------------------------------
'si il n'est pas fait référence à Microsoft Windows Image Acquisition Library v2.0, WIAAut.dll
Private Type FormatImg
 'wiaFormatBMP As String
 'wiaFormatGIF As String
 wiaFormatJPEG As String
 'wiaFormatPNG As String
 'wiaFormatTIFF As String
End Type
Dim TpImg As FormatImg
Private Sub Form_Load()
'si il n'est pas fait référence à Microsoft Windows Image Acquisition Library v2.0, WIAAut.dll
 'TpImg.wiaFormatBMP = "{B96B3CAB-0728-11D3-9D7B-0000F81EF32E}"
 'TpImg.wiaFormatGIF = "{B96B3CB0-0728-11D3-9D7B-0000F81EF32E}"
 TpImg.wiaFormatJPEG = "{B96B3CAE-0728-11D3-9D7B-0000F81EF32E}"
 'TpImg.wiaFormatPNG = "{B96B3CAF-0728-11D3-9D7B-0000F81EF32E}"
 'TpImg.wiaFormatTIFF = "{B96B3CB1-0728-11D3-9D7B-0000F81EF32E}"
'-------------------------Nouveauté--------------------------------------
Me.ScaleMode = vbPixels: Picture1.ScaleMode = vbPixels
Me.AutoRedraw = True: Picture1.AutoRedraw = True
Picture1.Visible = False
'-------------------------Fin nouveauté--------------------------------------
'juste pour modifier l'aspect du MSChart par code
MSChart1.Row = 1
MSChart1.RowLabel = "L1"
MSChart1.TitleText = "essais N°1"
MSChart1.SeriesColumn = 2
MSChart1.Data = 55
MSChart1.SeriesColumn = 5
MSChart1.Data = 15
End Sub
 
Private Sub Command1_Click()
'provisoir, a supprimer quand Ok
Static Num As Integer
On Error Resume Next
Kill App.Path & "\ImgTempo.jpg"
Err.Clear
Num = Num + 1
MSChart1.TitleText = "essais N°" & Num
DoEvents
 
 
 
'-------------- Old -------------------
'MSChart1.EditCopy
'Picture1.Picture = Clipboard.GetData
'-------------------------Nouveauté--------------------------------------
Picture1.Width = MSChart1.Width
Picture1.Height = MSChart1.Height
BitBlt Picture1.hDC, 0, 0, MSChart1.Width, MSChart1.Height, _
    GetDC(MSChart1.hwnd), 0, 0, vbSrcCopy
 
SavePicture Picture1.Image, App.Path & "\ImgTempo.bmp"
'-------------------------Fin nouveauté--------------------------------------
 
'adaptation du tuto de
'http://silkyroad.developpez.com/VBA/WindowsImageAcquisition/
'Il n'est pas besoin de faire référence à Microsoft Windows Image Acquisition Library v2.0, WIAAut.dll
 
    Dim Img1 As Object
    Dim IP 'As ImageProcess
 
    'Création conteneur pour l'image à manipuler
    Set Img1 = CreateObject("WIA.ImageFile")
 
    'Chargement de l'image dans le conteneur
    Img1.LoadFile (App.Path & "\ImgTempo.bmp")
    'Création du gestionnaire de filtre
    Set IP = CreateObject("WIA.ImageProcess")
    Dim AuFormat As String
    AuFormat = TpImg.wiaFormatJPEG
    IP.Filters.Add IP.FilterInfos("Convert").FilterID
    IP.Filters(1).Properties("FormatID").Value = AuFormat
    IP.Filters(1).Properties("Quality").Value = 100
 
    Set Img1 = IP.Apply(Img1)
 
 
    'sauvegarde de la nouvelle image en .jpg
    Img1.SaveFile (App.Path & "\ImgTempo.jpg")
    'supprime le fichier temporaire .bmp
    Kill App.Path & "\ImgTempo.bmp"
    'code pour inclure dans le pdf
    '...........
    'quand le pdf est OK
    'supprime le fichier temporaire .jpg
    'Kill App.Path & "\ImgTempo.jpg"
End Sub

Le premier code que je t'avais proposé fonctionnait correctement, pour moi, sur 2 ordinateurs d'OS différents.