Zantor,
Having seen Tom's post I lifted the clearcontents line from Harald's code
which sorts out the problem with the contents of the chart. This one seems
to work quite well.
Sub Test()
CopyRangeAsGif Selection, "c:\temp\test.gif"
End Sub
Sub CopyRangeAsGif(rngCells As Range, strLocation As String)
Dim chNew As Chart
Dim chObj As ChartObject
Dim lWidth As Long
Dim lHeight As Long
Dim nCounter As Integer
Dim shSource As Worksheet
On Error GoTo 0
If InStr(rngCells.Address, ",") 0 Then
MsgBox "Non contiguous range not permitted"
Exit Sub
End If
With rngCells
For nCounter = 1 To .Columns.Count
lWidth = lWidth + .Columns(nCounter).Width
Next nCounter
For nCounter = 1 To .Rows.Count
lHeight = lHeight + .Rows(nCounter).Height
Next nCounter
End With
Set chNew = Charts.Add
chNew.Location Whe=xlLocationAsObject, Name:=rngCells.Parent.Name
Set shSource = rngCells.Parent
Set chObj = shSource.ChartObjects(shSource.ChartObjects.Count)
rngCells.CopyPicture xlScreen, xlPicture
With ActiveChart
.Paste
.ChartArea.Border.LineStyle = 0
.ChartArea.ClearContents
End With
chObj.Width = lWidth + 4
chObj.Height = lHeight + 4
chObj.Chart.Export strLocation, "GIF", False
rngCells.Select
chObj.Delete
End Sub
Robin Hammond
www.enhanceddatasystems.com
Check out our XspandXL add-in
"Robin Hammond" wrote in message
...
Zantor,
This should get you going. You'll have to sort out the bit that hides
anything in the chart itself. Sometimes when I tried this there was data
in
the chart, other times it was blank, and the bit where I tried to set the
plotarea size to 0 doesn't really work to hide the chart itself. Easy to
write some code to get rid of anything in the chart though.
Sub Test()
CopyRangeAsGif Selection, "c:\temp\test.gif"
End Sub
Sub CopyRangeAsGif(rngCells As Range, strLocation As String)
Dim chNew As Chart
Dim chObj As ChartObject
Dim lWidth As Long
Dim lHeight As Long
Dim nCounter As Integer
Dim shSource As Worksheet
On Error GoTo 0
If InStr(rngCells.Address, ",") 0 Then
MsgBox "Non contiguous range not permitted"
Exit Sub
End If
With rngCells
For nCounter = 1 To .Columns.Count
lWidth = lWidth + .Columns(nCounter).Width
Next nCounter
For nCounter = 1 To .Rows.Count
lHeight = lHeight + .Rows(nCounter).Height
Next nCounter
End With
Set chNew = Charts.Add
chNew.Location Whe=xlLocationAsObject, Name:=rngCells.Parent.Name
Set shSource = rngCells.Parent
Set chObj = shSource.ChartObjects(shSource.ChartObjects.Count)
rngCells.CopyPicture xlScreen, xlPicture
With ActiveChart
.Paste
.ChartArea.Border.LineStyle = 0
.PlotArea.Width = 0
.PlotArea.Height = 0
End With
chObj.Width = lWidth + 2
chObj.Height = lHeight + 2
chObj.Chart.Export strLocation, "GIF", False
rngCells.Select
chObj.Delete
End Sub
--
Robin Hammond
www.enhanceddatasystems.com
Check out our XspandXL add-in
"Tom Ogilvy" wrote in message
...
so the answer is no - not directly. You would have to paste it in a
chart
object and use the export command to do it in VBA.
--
Regards,
Tom Ogilvy
"zantor" wrote in message
...
Hi Tegger,
One way to do it is to select the current cell, press ctrl-c, open
MS-Paint and press ctrl-v. Go to 'File', 'Save-As' and select the
'Gif'
format and save the file with the appropriate name.
Hope this will help you.
------------------------------------------------
~~ Message posted from http://www.ExcelTip.com/
~~ View and post usenet messages directly from
http://www.ExcelForum.com/