How to Insert MSchart picture into excel.
 

Hi,

I am trying to insert the picture from MSchart into excel but i am not
able to paste the image into excel.
This is the code which i have tried :
__________________________________________________ _____________
Private Sub Command2_Click()
Dim xlApp As Excel.Application
Dim xlWB As Excel.Workbook
Dim xlWS As Excel.Worksheet

Dim r,c,rv As Long
Dim Filename As String, objRange As Range
Dim SuggestedName,cmbCaseVar, cmbCaseVarSave As String
Dim MSG, Style, Response
Dim rtemp,CountVar As Integer

Set xlApp = CreateObject("Excel.Application")
Set xlWB = xlApp.Workbooks.Add
Set xlWS = xlWB.Worksheets("Sheet1")

xlApp.Visible = False
xlApp.UserControl = False
cmbCaseVar = cmbCase.Text
cmbCaseVarSave = cmbCase.Text

SuggestedName = "Test"
Filename = xlApp.GetSaveAsFilename("C:\" & SuggestedName & ".xls", _
"WorkBook (*.xls), *.xls", , "Select or enter a File Name:")
If Filename = "False" Then Exit Sub

If (Len(Dir$(Filename)) 0) Then
Style = vbYesNo + vbExclamation
MSG = "The file already exists," & vbCrLf & _
"would you like to overwrite it?"
Response = MsgBox(MSG, Style)
If Response = vbNo Then
GoTo Cleanup
End If
End If

On Error GoTo ErrorHandler
Open Filename For Binary Access _
Read Write Lock Read Write As #1
Close #1
On Error GoTo 0
On Error Resume Next

For r = 0 To MSFlexGrid1.Rows - 1
For c = 0 To MSFlexGrid1.Cols - 1
xlWS.Cells(r + 1, c) = MSFlexGrid1.TextMatrix(r, c)
Next
Next
xlWS.Cells.Columns.AutoFit
xlWS.PageSetup.PrintHeadings = True

'First Method
With xlWS.Range("A75")
Set Picture1 = .Parent.Pictures.Insert(Picture1.Picture)
End With

'Second MEthod
With Picture1
.Height = MSChart1.Height
.Width = MSChart1.Width
End With
Picture1.AutoRedraw = True
rv = SendMessage(MSChart1.hWnd, WM_PAINT, Picture1.hDC, 0)
Picture1.Picture = Picture1.Image
Picture1.AutoRedraw = False
Clipboard.Clear
Clipboard.SetData Picture1.Picture

InsertPictureInRange Picture1.Picture, xlWS.Range("A75:F95").Select

xlApp.DisplayAlerts = False 'overwrite existing file without prompt
xlWB.SaveAs Filename


Cleanup:
Call xlWB.Close(SaveChanges:=False)
xlApp.DisplayAlerts = True
xlApp.Quit
Set xlWB = Nothing
Set xlWS = Nothing
Set xlApp = Nothing

Exit Sub
ErrorHandler:
MsgBox "E R R O R - The file that your are trying to
access," _
& vbCrLf & "is already open." & vbCrLf & vbCrLf & _
"Please close the file and try again", vbCritical
GoTo Cleanup
End Sub

Private Sub InsertPictureInRange(PictureFile As PictureBox,
TargetCells As Range)
' inserts a picture and resizes it to fit the TargetCells range
Dim p As Object, t As Double, l As Double, w As Double, h As Double
Set p = ActiveSheet.Pictures.Insert(PictureFile.Picture)
' determine positions
With TargetCells
t = .Top
l = .Left
w = .Offset(0, .Columns.Count).Left - .Left
h = .Offset(.Rows.Count, 0).Top - .Top
End With
' position picture
With p
.Top = t
.Left = l
.Width = w
.Height = h
End With
Set p = Nothing
End Sub
________________________________________________

thanks in advance.

Sachin