rounakmoondra
New Member
- Joined
- Sep 10, 2010
- Messages
- 22
How do we save a picture present in excel to a folder on our desktop
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.......
Worksheets(1).ChartObjects(1).Chart.Export _
Filename:="C:\ChartImage.jpg", FilterName:="jpg"
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...
it would be great if you can provide me the clipboard code...
wil wait for your response...
thanks alot...
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
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