Discussion :

[bendesarts]

Bonjour,

Afin d'insérer dans un article des graphiques réalisées en Excel de meilleure qualité, j'aimerais insérer ces graphiques au format vectoriel.
Est-ce que vous sauriez comment on peut enregistrer un graphique excel au format vectoriel (fichier .emf par exemple) et sans lien avec les données ?
Merci pour vos idées.

[Jean-Philippe André]

Salut,

choppe sur staskoverflow

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
Option Explicit
 
Private Declare Function OpenClipboard _
    Lib "user32" ( _
        ByVal hwnd As Long) _
As Long
 
Private Declare Function CloseClipboard Lib "user32" () As Long
 
Private Declare Function GetClipboardData _
    Lib "user32" ( _
        ByVal wFormat As Long) _
As Long
 
Private Declare Function EmptyClipboard Lib "user32" () As Long
 
'// CreateMetaFileA DeleteEnhMetaFile
Private Declare Function CopyEnhMetaFileA _
    Lib "gdi32" ( _
        ByVal hENHSrc As Long, _
        ByVal lpszFile As String) _
As Long
 
Private Declare Function DeleteEnhMetaFile _
    Lib "gdi32" ( _
        ByVal hemf As Long) _
As Long
 
'la fonction en question
Public Function fnSaveAsEMF(strFileName As String) As Boolean
Const CF_ENHMETAFILE As Long = 14
 
Dim ReturnValue As Long
 
    OpenClipboard 0
 
    ReturnValue = CopyEnhMetaFileA(GetClipboardData(CF_ENHMETAFILE), strFileName)
 
    EmptyClipboard
 
    CloseClipboard
 
    '// Release resources to it eg You can now delete it if required
    '// or write over it. This is a MUST
    DeleteEnhMetaFile ReturnValue
 
    fnSaveAsEMF = (ReturnValue <> 0)
 
End Function

Et le code d'enregistrement

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
Sub SaveIt()
Charts.Add
    ActiveChart.ChartArea.Select
    Selection.Copy
    If fnSaveAsEMF("C:\Excel001.emf") Then
        MsgBox "Saved", vbInformation
    Else
        MsgBox "NOT Saved!", vbCritical
    End If
 
End Sub

[bendesarts]

Salut,

Merci pour ton aide. Mais, ta réponse est loin d'être une solution clé en main.
Est-ce que tu pourrais m'apporter des précisions sur comment utiliser cette technique ?
Visiblement, il faut installer une macro? Pourquoi alors il y a deux codes vba?
Merci pour vos complements d'infos

[Jean-Philippe André]

Bonjour,

je n'ai pas vocation a te donner une solution cle en main non plus tu sais

Le code VBA est la solution que je te propose, mais si tu trouves sans passer par du code, aucun soucis

Pour la partie en VBA en question, tu peux lire quelques elements pour commencer :
http://fauconnier.developpez.com/tut...istreur-macro/

Il te faudra recopier les lignes que je t'ai donnees dans un module.

[joe.levrai]

Bonjour,

pas une solution clé en main ? Il te manque quoi du coup, quelqu'un qui fait le copier coller à ta place de ces deux procédures ?

Le premier code, c'est le moteur qui permet la création
Le second code, c'est un exemple complet pour utiliser le moteur

Tu copies TOUT ça dans un module standard de ton projet VBA et tu adaptes Sub SaveIt() avec tes propres paramètres

Si tu veux que les contributeurs aillent encore plus loin dans le clé en main, va falloir que tu leur donnes une partie de ta rémunération, car ça devient clairement un "travail fait à ta place"

Sans animosité, mais il faut parfois dire les choses telles qu'elles se présentent ....

[bendesarts]

Et bien je crois qu'il me manquait ce que tu viens de m'apporter à savoir comment utiliser ces modules.

Le premier code, c'est le moteur qui permet la création
Le second code, c'est un exemple complet pour utiliser le moteur

Tu copies TOUT ça dans un module standard de ton projet VBA et tu adaptes Sub SaveIt() avec tes propres paramètres

Là, çà se précise. Désolé pour le mot "clé en main" qui n'était peut-être pas approprié. En tout cas, quelques phrases explicatives étaient à mon sens bien utile.

Merci pour votre aide

[joe.levrai]

You're Welcome

[bendesarts]

Bonjour,

Merci pour vos conseils.

J'ai crée un projet et, dans ce projet, un module contenant ce code :

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
Public Function fnSaveAsEMF(strFileName As String) As Boolean
Const CF_ENHMETAFILE As Long = 14
 
Dim ReturnValue As Long
 
    OpenClipboard 0
 
    ReturnValue = CopyEnhMetaFileA(GetClipboardData(CF_ENHMETAFILE), strFileName)
 
    EmptyClipboard
 
    CloseClipboard
 
    '// Release resources to it eg You can now delete it if required
    '// or write over it. This is a MUST
    DeleteEnhMetaFile ReturnValue
 
    fnSaveAsEMF = (ReturnValue <> 0)
 
End Function
 
Sub SaveIt()
Charts.Add
    ActiveChart.ChartArea.Select
    Selection.Copy
    If fnSaveAsEMF("C:\Users\boudon.b\Desktop\courbe.emf") Then
        MsgBox "Saved", vbInformation
    Else
        MsgBox "NOT Saved!", vbCritical
    End If
 
End Sub

Ensuite, je sélectionne un graphique et lance la macro SaveIt qui est apparut dans la fenetre Macros.

Par contre, celà ne fonctionne pas et j'obtiens le message d'erreur suivant :

Impossible d'executer en mode arret

Est-ce que vous auriez des idées afin que j'arrive à faire fonctionner ce module VBA correctement ?

Merci d'avance pour votre aide et vos conseils.

[Jean-Philippe André]

Salut,

une rapide recherche donne des exemples de solutions :

http://www.developpez.net/forums/d44...de-mode-arret/

1/ tu retires tous les points d'arret
2/ tu compiles le code