Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to comp.lang.basic.visual.misc,microsoft.public.excel.programming
external usenet poster
 
Posts: 1
Default 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
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
how do I insert picture into cell so vlookup can return picture? ah Excel Worksheet Functions 1 May 1st 07 04:38 AM
insert a picture in to a comment but picture not save on hard disk Pablo Excel Discussion (Misc queries) 0 February 21st 07 03:48 PM
How do I put a picture in excel with out using insert? RFCahoon Excel Discussion (Misc queries) 4 July 17th 05 03:07 AM
insert picture into excel Macca Excel Worksheet Functions 0 November 10th 04 03:44 PM
How to Insert Picture in Excel? Spike[_2_] Excel Programming 1 October 25th 03 12:36 AM


All times are GMT +1. The time now is 04:18 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"