Export excel2000 charts into EMF/WMF

[yongtao.yang]

Dear group,

I am trying to find out how to export an chart/diagramn from Excel2000
to an graphics file in EMF or WMF format. After a not-so-short google
search, I found two of the most popular solutions:

1. Copy the diagram and paste special as emf graphics into powerpoint,
adjust the page size to fit the diagram then save as WMF file

2. Use Stephen Bullen's Excel tool PastePicture availabe at
http://www.bmsltd.co.uk/Excel/Default.htm to save the diagram as an EMF
file

I don't like the first solution very much since it involves too much
manual work. So I went for the second one, however the PastePicture.zip
does not seem to work with Excel 2000 on my computer. When clicking the
SavePicture button and providing a file name, an error message poped
out with the following information:
"Runtime error number 380, invalid property value".

If I choose Debug from the error message box, the VBA window shows that
error happens at within the subroutine btn_ClickSave at the line
SavePicture oPic, vFile
where oPic has a value "Nothing".

I am not really sure what could be wrong here as I have never touch VBA
myself. Could some body help me with that?

Thanks in advance!

 

[Michel Pierron]

Hi, you can try:

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 SaveChart()
On Error GoTo 1
Const Graph$ = "Name of your chart"
Dim hCopy&, fName$
ActiveSheet.ChartObjects(Graph).Copy
OpenClipboard 0&
hCopy = GetClipboardData(14)
If hCopy Then
fName = ThisWorkbook.Path & "\" & Graph & ".wmf"
DeleteEnhMetaFile CopyEnhMetaFileA(hCopy, fName)
EmptyClipboard
End If
CloseClipboard
Exit Sub
1: MsgBox "Error " & Err.Number & vbLf & Err.Description, 48
End Sub

Regards,
MP

 

[Michel Pierron]

Hi,
test while replacing
ActiveSheet.ChartObjects(Graph).Copy
by
ActiveSheet.ChartObjects(Graph).Chart.CopyPicture _
Appearance:=xlScreen, Format:=xlPicture

MP

 

[yongtao.yang]

Hi,
test while replacing
ActiveSheet.ChartObjects(Graph).Copy
by
ActiveSheet.ChartObjects(Graph).Chart.CopyPicture _
Appearance:=xlScreen, Format:=xlPicture

MP

Hello Michel,

Thank you so much!

The new code gives the same error:
Error 1004, can not find property CharObjects for class Worksheet.

Back to the original code, at the line
Const Graph$ = "Name of your chart"

What should I put there to replace "Name of your chart", was is the
chart's title? I can not find a name for the chart.

Another question, my chart was created as an imbedded object inside a
worksheet, does it have to be an separate worksheet itself for the code
to work correctly?

Best Regards!

Yongtao

 

[Michel Pierron]

Hi again,

You have this error because the name of the graph is incorrect.
You must replace "Name of your chart" by the real name of the graph.
If you have one graph, you can modify the procedure as follows:

Sub SaveChart()
On Error GoTo 1
Const Graph$ = "Name under which I want to save"
Dim hCopy&, fName$
ActiveSheet.ChartObjects(1).Chart.CopyPicture
OpenClipboard 0&
hCopy = GetClipboardData(14)
If hCopy Then
'fName = ThisWorkbook.Path & "\" & Graph & ".wmf"
fName = "C:\" & Graph & ".wmf"
DeleteEnhMetaFile CopyEnhMetaFileA(hCopy, fName)
EmptyClipboard
End If
CloseClipboard
Exit Sub
1: MsgBox "Error " & Err.Number & vbLf & Err.Description, 48
End Sub

Regards,
MP

 

[yongtao.yang]

Hi again,

You have this error because the name of the graph is incorrect.
You must replace "Name of your chart" by the real name of the graph.
If you have one graph, you can modify the procedure as follows:

Sub SaveChart()
On Error GoTo 1
Const Graph$ = "Name under which I want to save"
Dim hCopy&, fName$
ActiveSheet.ChartObjects(1).Chart.CopyPicture
OpenClipboard 0&
hCopy = GetClipboardData(14)
If hCopy Then
'fName = ThisWorkbook.Path & "\" & Graph & ".wmf"
fName = "C:\" & Graph & ".wmf"
DeleteEnhMetaFile CopyEnhMetaFileA(hCopy, fName)
EmptyClipboard
End If
CloseClipboard
Exit Sub
1: MsgBox "Error " & Err.Number & vbLf & Err.Description, 48
End Sub

Regards,
MP

Hello,

Now it is better that excel does not pop up an error message, how ever
there is no wmf file created, and by running the code in debug mode, I
found that after the line
hCopy = GetClipboardData(14)
hCopy is assigned value zero, which then terminate the code. But I can
paste the picture usig Ctrl-V.

Best,

 

[Michel Pierron]

Hello,
By default, Excel uses EMF format. If the value of hCopy is equal to 0, I
think that you have an error of code.
Carry out a compilation of your code to raise the doubt.

Make the test below; you must have 1

Option Explicit
Private Declare Function _
CloseClipboard& Lib "user32" ()
Private Declare Function _
OpenClipboard& Lib "user32" (ByVal hwnd&)
Private Declare Function _
EmptyClipboard& Lib "user32" ()
Private Declare Function IsClipboardFormatAvailable _
Lib "user32" (ByVal wFormat&) As Long

Sub ClipboardFormat()
ActiveSheet.ChartObjects(1).Chart.CopyPicture
OpenClipboard 0&
MsgBox IsClipboardFormatAvailable(3), 64
EmptyClipboard
CloseClipboard
End Sub

MP

 

[yongtao.yang]

Hi Michel,

Running the code below, a mesage box poped up with a "0" inside it.

Best regards,