Best format to export Excel Range to picture?? WMF??

[Marcus]

Hi guys,

I am trying to export an Excel range into "nice picture" format. But
exporting as GIF, the quality is too low (we cannot read the number!).
Instead of GIF, can we save the range as Windows Metafile Picture format?? Or
is my code is wrong? Any suggestion?
Thank you in advance for your expertise!!

Yvan


Please find my code:
Private Sub SaveRangeAsGIF1()
Dim r As Range
Dim varFullPath As Variant
Dim Graph As String
Application.ScreenUpdating = False
Set r = Range("a1:v32")
r.Select
' copy with .CopyPicture
Selection.CopyPicture appearance:=xlScreen, Format:=xlBitmap
' use chart to ease the export and create a chart
Workbooks.Add (1)
ActiveSheet.Name = "inGIF"
Charts.Add
ActiveChart.ChartType = xl3DArea
ActiveChart.SetSourceData r
ActiveChart.Location xlLocationAsObject, "inGIF"
' chart as transition and use .ClearContents
ActiveChart.ChartArea.ClearContents
‘paste the chart
ActiveChart.Paste
Graph = Mid(ActiveChart.Name, Len(ActiveSheet.Name) + 1)
' export
varFullPath =
Application.GetSaveAsFilename("C:\Temp\Actuapedia_CPA_RSLT-" & Format(Now,
"yyyymmddhhnn") & ".gif", _
"Fichiers GIF (*.gif), *.gif")
ActiveChart.Export varFullPath, "GIF"
ActiveChart.Pictures(1).Delete
ActiveWorkbook.Close False
End Sub

 

[Leith Ross]

Hi guys,

I am trying to export an Excel range into "nice picture" format. But
exporting as GIF, the quality is too low (we cannot read the number!).
Instead of GIF, can we save the range as Windows Metafile Picture format?? Or
is my code is wrong? Any suggestion?
Thank you in advance for your expertise!!

Yvan

Please find my code:
Private Sub SaveRangeAsGIF1()
Dim r As Range
Dim varFullPath As Variant
Dim Graph As String
Application.ScreenUpdating = False
Set r = Range("a1:v32")
r.Select
' copy with .CopyPicture
Selection.CopyPicture appearance:=xlScreen, Format:=xlBitmap
' use chart to ease the export and create a chart
Workbooks.Add (1)
ActiveSheet.Name = "inGIF"
Charts.Add
ActiveChart.ChartType = xl3DArea
ActiveChart.SetSourceData r
ActiveChart.Location xlLocationAsObject, "inGIF"
' chart as transition and use .ClearContents
ActiveChart.ChartArea.ClearContents
'paste the chart
ActiveChart.Paste
Graph = Mid(ActiveChart.Name, Len(ActiveSheet.Name) + 1)
' export
varFullPath =
Application.GetSaveAsFilename("C:\Temp\Actuapedia_CPA_RSLT-" & Format(Now,
"yyyymmddhhnn") & ".gif", _
"Fichiers GIF (*.gif), *.gif")
ActiveChart.Export varFullPath, "GIF"
ActiveChart.Pictures(1).Delete
ActiveWorkbook.Close False
End Sub

Hello Marcus,

Change your CopyPicture Format constant from xlBitmap to xlPicture.
This will copy the chart as a metafile picture.

Selection.CopyPicture appearance:=xlScreen, Format:=xlPicture

Sincerely,
Leith Ross

 

[Peter T]

Irrespective of what format you copy the image of the range to the
clipboard, when you paste to the chart and save as Gif that's what you'll
get, a gif image. But normally a Gif should be fine. Have a go with the
following -

Sub Rng2GifTest()
Dim sfilename As String
Dim chtObj As ChartObject
Dim cht As Chart

sFile = "c:\temp\Rng2ChartTest.gif"

On Error Resume Next
Kill sFile
On Error GoTo 0

With Range("A1:H15")
.Value = 123.4567 ' just for testing of course

.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
'size to range plus a bit for chart border
Set chtObj = ActiveSheet.ChartObjects.Add( _
.Left, .Top, .Width + 6, .Height + 6)
End With

chtObj.Chart.Paste
chtObj.Chart.Export sFile ' default filter is Gif
chtObj.Delete

End Sub

The main advantage WMF/EMF will have offer over GIF is resizing the image.
In theory you can export the chart with whatever filter your system can
support. However many systems appear to support little more than the default
GIF format (don't bother writing the default gif filter, potentially does
more harm than good).

If the above is not good enough, I suspect the only alternative would be to
write the clipboard image to file directly (lot of API stuff).

Regards,
Peter T


Normally Gif format should be fine.

 

[Marcus]

I get an error message with:
..Value = 123.4567

Why this line is for? By what can we replace it?

Many thanks for your expertise Guys!

Yvan

 

[Peter T]

Not sure why that errors, it was only a lazy way to fill the range with some
values for testing. Change the range to whatever you want and just do the
following

With Range("A1:H15") ' < change
'' .Value = 123.4567 ' remove this

.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
'size to range plus a bit for chart border
Set chtObj = ActiveSheet.ChartObjects.Add( _
.Left, .Top, .Width + 6, .Height + 6)
End With

Actually, the only reasons I imagine why that line would error is if
- it was not placed within a With rng . End With block,
- cells are protected
- the activesheet is not a worksheet.

Regards,
Peter T

 

[Marcus]

Hi Peter, you know what? You are just genious!!! It works perfectly!!
Many thanks!!