Exporter un graphique en WMF par VBA

Bonsoir François;

1- Il faut ajouter une ligne au cas ou l'utilisateur abandonne sur InputBox:
If cName = "" Then Exit Sub

2- Avec l'instruction ActiveChart.ChartArea.Copy, si aucun graphique n'est
sélectionné, cela engendrera une erreur de type 91. Pour éviter celà, tu
devrais modifier la gestion d'erreur pour en avertir l'utilisateur:
SaveWmf_Error:
If Err.Number = 91 Then
MsgBox "Aucun graphique n'est sélectionné !", 64
Else
MsgBox "Error " & Err.Number & vbLf & Err.Description, 48
End If

3- Si tu souhaites une meilleure définition, tu peux essayer en modifiant
l'instruction de copie comme ceci:
ActiveChart.CopyPicture: OpenClipboard 0&


MP


"Francois L" <francois@noadress.fr.invalid> a écrit dans le message de news:
uJKe2lGpHHA.2452@TK2MSFTNGP02.phx.gbl...

Bonjour François;
Bonsoir Michel,

Testé sur XL97 + XP et sur XL2000 + Me. Dans les deux cas ça marche, sans
soucis et l'image obtenue est d'une qualité très correcte compte tenu de
son poids même si cela reste inférieur à ce que l'on obtient avec un
"copier image", "coller comme metafichier".

J'ai fait des modifs pour gérer la saisie d'un nom de fichier, coller dans
le répertoire du classeur actif et n'exporter que le graphique actif, y
compris s'il est sur une feuille graphique. Ca donne ce qui suit, merci de
me dire si tu y vois une co.....e.

Private Declare Function _
CloseClipboard& Lib "user32" ()
Private Declare Function _
OpenClipboard& Lib "user32" (ByVal hwnd&)
Private Declare Function _
EmptyClipboard& Lib "user32" ()
Private Declare Function _
GetClipboardData& Lib "user32" (ByVal wFormat&)
Private Declare Function CopyEnhMetaFileA& _
Lib "gdi32" (ByVal hemfSrc&, ByVal lpszFile$)
Private Declare Function _
DeleteEnhMetaFile& Lib "gdi32.dll" (ByVal hemf&)

Sub SaveAsMetafile()
On Error GoTo SaveWmf_Error
Dim hCopy&, fName$, cName$, pName$
pName = ActiveWorkbook.Path
cName = InputBox("Nom du fichier image (sans extension)")
ActiveChart.ChartArea.Copy: OpenClipboard 0&
hCopy = GetClipboardData(14)
If hCopy Then
fName = pName & "" & cName & ".wmf"
DeleteEnhMetaFile CopyEnhMetaFileA(hCopy, fName)
EmptyClipboard
End If
CloseClipboard
Exit Sub
SaveWmf_Error:
MsgBox "Error " & Err.Number & vbLf & Err.Description, 48
End Sub

--
François L

Essaie comme ceci:

Private Declare Function _
CloseClipboard& Lib "user32" ()
Private Declare Function _
OpenClipboard& Lib "user32" (ByVal hwnd&)
Private Declare Function _
EmptyClipboard& Lib "user32" ()
Private Declare Function _
GetClipboardData& Lib "user32" (ByVal wFormat&)
Private Declare Function CopyEnhMetaFileA& _
Lib "gdi32" (ByVal hemfSrc&, ByVal lpszFile$)
Private Declare Function _
DeleteEnhMetaFile& Lib "gdi32.dll" (ByVal hemf&)

Sub SaveAsMetafile()
If ThisWorkbook.Sheets(1).ChartObjects.Count = 0 Then Exit Sub
On Error GoTo SaveWmf_Error
Dim Img As ChartObject, hCopy&, fName$
For Each Img In ThisWorkbook.Sheets(1).ChartObjects
Img.Copy: OpenClipboard 0&
hCopy = GetClipboardData(14)
If hCopy Then
fName = "C:" & Img.Name & ".wmf"
DeleteEnhMetaFile CopyEnhMetaFileA(hCopy, fName)
EmptyClipboard
End If
CloseClipboard
Next Img
Exit Sub
SaveWmf_Error:
MsgBox "Error " & Err.Number & vbLf & Err.Description, 48
End Sub

MP


"Francois L" <francois@noadress.fr.invalid> a écrit dans le message de
news: %23qveeK0oHHA.668@TK2MSFTNGP05.phx.gbl...

Bonjour à tous,

Est-ce que quelqu'un saurait faire ça ?
Les classiques GIF, JPEG, etc. je sais mais j'aurais vraiment besoin de
créer des WMF !

Merci

--
François L