save a picture on desktop

[rounakmoondra]

How do we save a picture present in excel to a folder on our desktop

 

[Jaafar Tribak]

I have tried this ....export method but the resolution is not good but by taking a picture of graph give more clarity.....
hence i have saved chart on sheet as a picture and now either from
the sheet or from clipboard i want to save it in a folder on my laptop....

thanks for your inputs.......

You can save the Chart pic as JEPG File but i am not sure that would make the picture quality any clearer.

Worksheets(1).ChartObjects(1).Chart.Export _
Filename:="C:\ChartImage.jpg", FilterName:="jpg"

As for copying the chart to the Clipboard and then saving it to disk this can be done via the OleCreatePictureIndirect API . Do a search here and I am sure you will find some sample code.

 

[rounakmoondra]

i have tried all...
jpeg...png bitmap...
prob is with export feature...it does not give same pic as you c when you plot the graph....hence i want to avoid export funtion....and use normal copy and save...

 

[Jaafar Tribak]

i have tried all...
jpeg...png bitmap...
prob is with export feature...it does not give same pic as you c when you plot the graph....hence i want to avoid export funtion....and use normal copy and save...

I couldn't reproduce your problem. The difference in clarity between the exported chart and the actual chart on the worksheet is hardly noticeable.

Note that when exporting the chart as a JEPG file as opposed to a GIF file, the size of the resulting picture file is much bigger meaning it should be of a better quality.

Anyway, will post some code later that grabs the chart picture from the clipboard using the OleCreatePictureIndirect API and see if the image you get is better. If that fails too then i am afraid I don't know.

 

[rounakmoondra]

it would be great if you can provide me the clipboard code...
wil wait for your response...
thanks alot...

 

[Jaafar Tribak]

it would be great if you can provide me the clipboard code...
wil wait for your response...
thanks alot...

Here is a quick adaptation of the PastePicture function by Stephen Bullen.

The code below copies the chart to the Clipboard as xlPicture and then from there you can save the chart picture in different image file formats bmp , gif , jpg ... ( Compare their quality )

Place this code in a Standard module :

Option Explicit
 
Private Declare Function OpenClipboard Lib "user32" _
(ByVal hwnd As Long) As Long
 
Private Declare Function GetClipboardData Lib "user32" _
(ByVal wFormat As Integer) As Long
 
Private Declare Function CloseClipboard Lib "user32" () As Long
 
Private Declare Function IsClipboardFormatAvailable Lib "user32" _
(ByVal wFormat As Integer) As Long
 
Private Declare Function OleCreatePictureIndirect _
Lib "olepro32.dll" _
(PicDesc As uPicDesc, RefIID As GUID, _
ByVal fPictureOwnsHandle As Long, _
IPic As IPicture) As Long
 
'\\ Declare a UDT to store a GUID for the IPicture OLE Interface
Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7) As Byte
End Type
 
'\\ Declare a UDT to store the bitmap information
Private Type uPicDesc
    Size As Long
    Type As Long
    hPic As Long
    hPal As Long
End Type
 
Const CF_ENHMETAFILE = 14
Const PICTYPE_ENHMETAFILE = 4
 
Private Sub SaveChartAsMetaFile _
(Chart As ChartObject, Filename As String)
 
    Dim IID_IDispatch As GUID
    Dim uPicinfo As uPicDesc
    Dim IPic As IPicture
    Dim hPtr As Long
 
 
    '\\ Copy the chart to ClipBoard
    Chart.CopyPicture Appearance:=xlScreen, Format:=xlPicture
 
    '\\ Check if the metafile format is in the clipboard.
    If IsClipboardFormatAvailable(CF_ENHMETAFILE) <> 0 Then
 
    '\\ get a handle to the image.
        OpenClipboard 0
 
        hPtr = GetClipboardData(CF_ENHMETAFILE)
 
        CloseClipboard
 
        If hPtr <> 0 Then
 
        '\\ Create the interface GUID for the picture
            With IID_IDispatch
                .Data1 = &H7BF80980
                .Data2 = &HBF32
                .Data3 = &H101A
                .Data4(0) = &H8B
                .Data4(1) = &HBB
                .Data4(2) = &H0
                .Data4(3) = &HAA
                .Data4(4) = &H0
                .Data4(5) = &H30
                .Data4(6) = &HC
                .Data4(7) = &HAB
            End With
 
            '\\ Fill uPicInfo with necessary parts.
            With uPicinfo
                .Size = Len(uPicinfo) '\\ Length of structure.
                .Type = PICTYPE_ENHMETAFILE '\\ Type of Picture
                .hPic = hPtr '\\ Handle to image.
                .hPal = 0 '\\ Handle to palette (if bitmap).
            End With
 
            '\\ Create the Range Picture Object
            OleCreatePictureIndirect uPicinfo, IID_IDispatch, True, IPic
 
            On Error Resume Next
            '\\ Save Picture Object to disk.
            stdole.SavePicture IPic, Filename
 
 
            '\\ validate the filename.
            If Err = 76 Then
                MsgBox Err.Description
                On Error GoTo 0
            End If
 
        End If
 
    End If
 
End Sub

Usage example :

Sub Test()
 
    '\\ save the chart in 4 different image formats.
    SaveChartAsMetaFile Sheets(1).ChartObjects(1), "C:\ChartImage1.bmp"
    SaveChartAsMetaFile Sheets(1).ChartObjects(1), "C:\ChartImage2.jpg"
    SaveChartAsMetaFile Sheets(1).ChartObjects(1), "C:\ChartImage3.gif"
    SaveChartAsMetaFile Sheets(1).ChartObjects(1), "C:\ChartImage4.png"
End Sub

Are you getting a better picture resolution with this ?

 

[rounakmoondra]

I am getting the following error

"The specified dimension is not valied for the current chart type"
as soon as it calls the function.

SaveChartAsMetaFile Chart3.ChartObjects(1), "C:\ChartImage1.bmp"
-as chart3 is the object name and sheet name on which it is present is named as chart1

 

[rounakmoondra]

There is a sheet -Chart1 contains chart.
I want to copy that chart and place it in excel sheet -Sheet1
I recorded the macro and below is the output if I rerun the macro i get error at
ActiveSheet.ChartObjects("Chart 3").Activate
------------------------------------
Sheets("Chart1").Select
ActiveChart.ChartArea.Select
ActiveChart.ChartArea.Copy
Sheets("Sheet1").Select
Range("A3").Select
ActiveWindow.SmallScroll Down:=15
ActiveSheet.ChartObjects("Chart 3").Activate 'ERROR
ActiveSheet.Shapes("Chart 3").ScaleWidth 0.5646760764, msoFalse, _
msoScaleFromTopLeft
ActiveSheet.Shapes("Chart 3").ScaleHeight 0.334718463, msoFalse, _
msoScaleFromTopLeft
ActiveSheet.ChartObjects("Chart 3").Activate
ActiveChart.ChartArea.Copy
Range("K3").Select
ActiveSheet.Pictures.Paste.Select
Sheets("Data").Select
-------------------------------------------------------------------

Please let me know what should i do
thanks