I like the way one can export a chart to a gif, is it possible to export a
picture in Excel. I like the way one can program to take a "picture of a
range of cells, but want to be able to export this picture as a gif. is the
only way to put it in a blank chart?

Thanks

Joe,

As far as I am aware, yes. This is something I came up with earlier this
week in response to another post. There are other similar solutions out
there too. I haven't tested this much, but it seems to work ok.

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


"Joe 90" wrote in message
...
I like the way one can export a chart to a gif, is it possible to export a
picture in Excel. I like the way one can program to take a "picture of a
range of cells, but want to be able to export this picture as a gif. is
the
only way to put it in a blank chart?

Thanks

Thanks

Will try this out


"Robin Hammond" wrote in message
...
Joe,

As far as I am aware, yes. This is something I came up with earlier this
week in response to another post. There are other similar solutions out
there too. I haven't tested this much, but it seems to work ok.

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


"Joe 90" wrote in message
...
I like the way one can export a chart to a gif, is it possible to export
a
picture in Excel. I like the way one can program to take a "picture of a
range of cells, but want to be able to export this picture as a gif. is
the
only way to put it in a blank chart?

Thanks

Robin

I can see how the code should work but
I am getting "End of statement" errors in 4 places in your code:

With rngCells
For nCounter = 1 To .Columns.Count
HERE! lWidth = lWidth .Columns(nCounter).Width
Next nCounter

For nCounter = 1 To .Rows.Count
HERE! lHeight = lHeight .Rows(nCounter).Height
Next nCounter

End With


and

HERE! chObj.Width = lWidth 4
HERE! chObj.Height = lHeight 4


Is there something I need to activate or do to make this work properly
(I have copied and pasted your code from your message exactly, and tried
removing/adding spaces, parentheses etc to no effect)

Thanks

Joe
"Robin Hammond" wrote in message
...
Joe,

As far as I am aware, yes. This is something I came up with earlier this
week in response to another post. There are other similar solutions out
there too. I haven't tested this much, but it seems to work ok.

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


"Joe 90" wrote in message
...
I like the way one can export a chart to a gif, is it possible to export
a
picture in Excel. I like the way one can program to take a "picture of a
range of cells, but want to be able to export this picture as a gif. is
the
only way to put it in a blank chart?

Thanks

For some reason, you lost the plusses in that expression:

lWidth = lWidth + .Columns(nCounter).Width
lHeight = lHeight + .Rows(nCounter).Height

there's a "space, Plus sign, space" directly in front of the .columns and .rows
stuff.

Joe 90 wrote:

Robin

I can see how the code should work but
I am getting "End of statement" errors in 4 places in your code:

With rngCells
For nCounter = 1 To .Columns.Count
HERE! lWidth = lWidth .Columns(nCounter).Width
Next nCounter

For nCounter = 1 To .Rows.Count
HERE! lHeight = lHeight .Rows(nCounter).Height
Next nCounter

End With

and

HERE! chObj.Width = lWidth 4
HERE! chObj.Height = lHeight 4

Is there something I need to activate or do to make this work properly
(I have copied and pasted your code from your message exactly, and tried
removing/adding spaces, parentheses etc to no effect)

Thanks

Joe
"Robin Hammond" wrote in message
...
Joe,

As far as I am aware, yes. This is something I came up with earlier this
week in response to another post. There are other similar solutions out
there too. I haven't tested this much, but it seems to work ok.

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


"Joe 90" wrote in message
...
I like the way one can export a chart to a gif, is it possible to export
a
picture in Excel. I like the way one can program to take a "picture of a
range of cells, but want to be able to export this picture as a gif. is
the
only way to put it in a blank chart?

Thanks





--

Dave Peterson

Thanks Dave, just saw the thread. Was playing bad golf.

Robin Hammond
www.enhanceddatasystems.com
Check out our XspandXL add-in


"Dave Peterson" wrote in message
...
For some reason, you lost the plusses in that expression:

lWidth = lWidth + .Columns(nCounter).Width
lHeight = lHeight + .Rows(nCounter).Height

there's a "space, Plus sign, space" directly in front of the .columns and
..rows
stuff.

Joe 90 wrote:

Robin

I can see how the code should work but
I am getting "End of statement" errors in 4 places in your code:

With rngCells
For nCounter = 1 To .Columns.Count
HERE! lWidth = lWidth .Columns(nCounter).Width
Next nCounter

For nCounter = 1 To .Rows.Count
HERE! lHeight = lHeight .Rows(nCounter).Height
Next nCounter

End With

and

HERE! chObj.Width = lWidth 4
HERE! chObj.Height = lHeight 4

Is there something I need to activate or do to make this work properly
(I have copied and pasted your code from your message exactly, and tried
removing/adding spaces, parentheses etc to no effect)

Thanks

Joe
"Robin Hammond" wrote in message
...
Joe,

As far as I am aware, yes. This is something I came up with earlier
this
week in response to another post. There are other similar solutions
out
there too. I haven't tested this much, but it seems to work ok.

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


"Joe 90" wrote in message
...
I like the way one can export a chart to a gif, is it possible to
export
a
picture in Excel. I like the way one can program to take a "picture
of a
range of cells, but want to be able to export this picture as a gif.
is
the
only way to put it in a blank chart?

Thanks





--

Dave Peterson

Robin,

Thanks for providing CopyRangeAsGif.

It works great except the temporary chart sometimes
overlaps part of my selection. Then the "picture" includes
part of this chart (not sure if this only applies to me).

With a few minor changes I've got around this by putting
the temporary chart in another workbook, in particular my
Personal.xls where I'm also putting your code.

Regards,
Sandy

-----Original Message-----
Joe,

As far as I am aware, yes. This is something I came up
with earlier this
week in response to another post. There are other similar
solutions out
there too. I haven't tested this much, but it seems to
work ok.

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


"Joe 90" wrote in message
...
I like the way one can export a chart to a gif, is it
possible to export a
picture in Excel. I like the way one can program to
take a "picture of a
range of cells, but want to be able to export this
picture as a gif. is
the
only way to put it in a blank chart?

Thanks




.

Sandy,

You're welcome, and good idea to put it somewhere else. As I said I hadn't
fully tested it.

Robin Hammond
www.enhanceddatasystems.com
Check out our XspandXL add-in


"Sandy V" wrote in message
...
Robin,

Thanks for providing CopyRangeAsGif.

It works great except the temporary chart sometimes
overlaps part of my selection. Then the "picture" includes
part of this chart (not sure if this only applies to me).

With a few minor changes I've got around this by putting
the temporary chart in another workbook, in particular my
Personal.xls where I'm also putting your code.

Regards,
Sandy

-----Original Message-----
Joe,

As far as I am aware, yes. This is something I came up
with earlier this
week in response to another post. There are other similar
solutions out
there too. I haven't tested this much, but it seems to
work ok.

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


"Joe 90" wrote in message
...
I like the way one can export a chart to a gif, is it
possible to export a
picture in Excel. I like the way one can program to
take a "picture of a
range of cells, but want to be able to export this
picture as a gif. is
the
only way to put it in a blank chart?

Thanks




.

Thanks for writing this out, as I don't see your plusses either !!


"Dave Peterson" wrote in message
...
For some reason, you lost the plusses in that expression:

lWidth = lWidth .Columns(nCounter).Width
lHeight = lHeight .Rows(nCounter).Height

there's a "space, Plus sign, space" directly in front of the .columns and
..rows
stuff.

Joe 90 wrote:

Robin

I can see how the code should work but
I am getting "End of statement" errors in 4 places in your code:

With rngCells
For nCounter = 1 To .Columns.Count
HERE! lWidth = lWidth .Columns(nCounter).Width
Next nCounter

For nCounter = 1 To .Rows.Count
HERE! lHeight = lHeight .Rows(nCounter).Height
Next nCounter

End With

and

HERE! chObj.Width = lWidth 4
HERE! chObj.Height = lHeight 4

Is there something I need to activate or do to make this work properly
(I have copied and pasted your code from your message exactly, and tried
removing/adding spaces, parentheses etc to no effect)

Thanks

Joe
"Robin Hammond" wrote in message
...
Joe,

As far as I am aware, yes. This is something I came up with earlier
this
week in response to another post. There are other similar solutions
out
there too. I haven't tested this much, but it seems to work ok.

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


"Joe 90" wrote in message
...
I like the way one can export a chart to a gif, is it possible to
export
a
picture in Excel. I like the way one can program to take a "picture
of a
range of cells, but want to be able to export this picture as a gif.
is
the
only way to put it in a blank chart?

Thanks





--

Dave Peterson

Robin et al,

Have put your efforts to good effect and expanded on them. As I got to work
on my problem, I realised that I needed to work with the original photo
before it got onto the spreadsheet and also take account of portrait photos
as well as landscape ones, and the aim was to reduce the overall size of the
spreadsheet by making a small gif of the original photo, to end up with a
usable databse of data and accompanying photos. The resultant code helps to
show what I came up with, which, as a novice, I am quite chuffed with!
Hopefully the notes make sense and this code can be of use for others. If
anyone can tidy it up and make a neater job of it, I am all ears!

Regards

Joe90

++++++++++++++++++++++++++++++++++++++++++++++++++ +++++++++++++

Sub ConvertToGif()

'Converts a base picture to gif using chart export
'and pastes gif to spreadsheet, also copes with portrait/landscape pictures,
sizing to height only

'fname relates to a compiled filename on the spreadsheet in column 2 of the
active row

'picture size is set to fit a cell 8 columns in from the left, 105w x 150h
in points and allows for a border of 4 around it
'as pasting a picture into the chart forces a border on the top and left

'working sheet is called "data", and the range is "a100" which I know is
blank, to create a blank chart

'"Picture 17.gif" allows for a default picture in my main application,
incase a picture is not available
'you can delete the IF/Else part for "filetoopen" if you want

'thanks to Robin Hammond for the starting point on this!


Dim lWidth As Long
Dim lHeight As Long
Dim chtname
Dim chtnametrim
Static strlocation As String

filetoopen = Application.GetOpenFilename("Image Files (*.gif;*.jpg;*.bmp),
*.gif;*.jpg;*.bmp")
fname = ActiveCell.Offset(0, -ActiveCell.Column 2)
strlocation = ThisWorkbook.Path & "\" & fname & ".gif"

If filetoopen = ThisWorkbook.Path & "\Picture 17.gif" Then
ActiveSheet.Pictures.Insert filetoopen
Else
Charts.Add
ActiveChart.SetSourceData Source:=Sheets("data").Range("a100")
ActiveChart.Location Whe=xlLocationAsObject, Name:="Data"
With ActiveChart
.Pictures.Insert filetoopen
.ChartArea.Border.LineStyle = 0
.ChartArea.ClearContents
If .Shapes(1).Width .Shapes(1).Height Then
.Shapes(1).LockAspectRatio = msoFalse
ActiveChart.Shapes(1).Width = 142
ActiveChart.Shapes(1).Height = 97
Else
ActiveChart.Shapes(1).Height = 97
End If
lWidth = ActiveChart.Shapes(1).Width
lHeight = ActiveChart.Shapes(1).Height
End With
chtname = ActiveChart.Name
chtnametrim = Mid(chtname, 6, 20)
ActiveSheet.Shapes(chtnametrim).Width = lWidth 8
ActiveSheet.Shapes(chtnametrim).Height = lHeight 8
ActiveChart.Export strlocation, "GIF", False

ActiveChart.ChartArea.Select
Selection.Clear
With Sheets("data")
ActiveCell.Offset(0, -ActiveCell.Column 9).Select
..Pictures.Insert strlocation
End With
End If
End Sub
++++++++++++++++++++++++++++++++++++++++++++++++++ +++++++++

"Robin Hammond" wrote in message
...
Thanks Dave, just saw the thread. Was playing bad golf.

Robin Hammond
www.enhanceddatasystems.com
Check out our XspandXL add-in


"Dave Peterson" wrote in message
...
For some reason, you lost the plusses in that expression:

lWidth = lWidth .Columns(nCounter).Width
lHeight = lHeight .Rows(nCounter).Height

there's a "space, Plus sign, space" directly in front of the .columns
and
.rows
stuff.

Joe 90 wrote:

Robin

I can see how the code should work but
I am getting "End of statement" errors in 4 places in your code:

With rngCells
For nCounter = 1 To .Columns.Count
HERE! lWidth = lWidth .Columns(nCounter).Width
Next nCounter

For nCounter = 1 To .Rows.Count
HERE! lHeight = lHeight .Rows(nCounter).Height
Next nCounter

End With

and

HERE! chObj.Width = lWidth 4
HERE! chObj.Height = lHeight 4

Is there something I need to activate or do to make this work properly
(I have copied and pasted your code from your message exactly, and
tried
removing/adding spaces, parentheses etc to no effect)

Thanks

Joe
"Robin Hammond" wrote in message
...
Joe,

As far as I am aware, yes. This is something I came up with earlier
this
week in response to another post. There are other similar solutions
out
there too. I haven't tested this much, but it seems to work ok.

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


"Joe 90" wrote in message
...
I like the way one can export a chart to a gif, is it possible to
export
a
picture in Excel. I like the way one can program to take a
"picture
of a
range of cells, but want to be able to export this picture as a
gif.
is
the
only way to put it in a blank chart?

Thanks





--

Dave Peterson

I think www.irfanview.com does all you need, one of the
best freeware app's out there. It can Batch convert file
types and resize at the same time (see batch/advanced
options), and much else. Although for batch resizing you
might first need to sort portrait/landscape, which you
could do in code (unless you have hundreds probably not
worthwhile).

Some ideas for you to play with to tidy up your code:

You can add an embedded chart, correctly sized and
referenced in one go. Here's a snippet of my adaptation of
Robin's original -

Dim chObj As ChartObject
'get 'lWidth & lHeight dimensions of your picture per
Robin's original or resized to your needs. Add extra
border to each (say 4)

Set chObj = Worksheets("Sheet2"). _
ChartObjects.Add(10, 10, lWidth, lHeight)
'Don't need to set any source data.
With chObj.Chart
.Paste 'the previously copied picture
.ChartArea.Border.LineStyle = 0
.ChartArea.ClearContents
.Export strLocation, "GIF", False
End With
chObj.Delete

Rather than inserting the image direct to the chart, try
first inserting it to a sheet (if it's not already there),
resize it as required, copy it, and paste it to
the "sized" chart as above.

Perhaps change the file address before exporting:
StrLocation = strLocation & "_MyMod"

With Robin's original I found it necessary to put the
chart not on the activesheet. In the above it is
elsewhere in the activeworkbook, although for my purposes
I put it in another workbook. Requires a bit of
referencing and switching workbooks. But for what you are
currently doing this is not relevant.

I still think IrfanView is better!

Regards,
Sandy

PS Your newsreader appears not to like plus's and some
other characters

-----Original Message-----
Robin et al,

Have put your efforts to good effect and expanded on
them. As I got to work
on my problem, I realised that I needed to work with the
original photo
before it got onto the spreadsheet and also take account
of portrait photos
as well as landscape ones, and the aim was to reduce the
overall size of the
spreadsheet by making a small gif of the original photo,
to end up with a
usable databse of data and accompanying photos. The
resultant code helps to
show what I came up with, which, as a novice, I am quite
chuffed with!
Hopefully the notes make sense and this code can be of
use for others. If
anyone can tidy it up and make a neater job of it, I am
all ears!

Regards

Joe90

+++++++++++++++++++++++++++++++++++++++++++++++++ +++++++++
+++++

Sub ConvertToGif()

'Converts a base picture to gif using chart export
'and pastes gif to spreadsheet, also copes with
portrait/landscape pictures,
sizing to height only

'fname relates to a compiled filename on the spreadsheet
in column 2 of the
active row

'picture size is set to fit a cell 8 columns in from the
left, 105w x 150h
in points and allows for a border of 4 around it
'as pasting a picture into the chart forces a border on
the top and left

'working sheet is called "data", and the range is "a100"
which I know is
blank, to create a blank chart

'"Picture 17.gif" allows for a default picture in my main
application,
incase a picture is not available
'you can delete the IF/Else part for "filetoopen" if you
want

'thanks to Robin Hammond for the starting point on this!


Dim lWidth As Long
Dim lHeight As Long
Dim chtname
Dim chtnametrim
Static strlocation As String

filetoopen = Application.GetOpenFilename("Image Files
(*.gif;*.jpg;*.bmp),
*.gif;*.jpg;*.bmp")
fname = ActiveCell.Offset(0, -ActiveCell.Column 2)
strlocation = ThisWorkbook.Path & "\" & fname & ".gif"

If filetoopen = ThisWorkbook.Path & "\Picture 17.gif" Then
ActiveSheet.Pictures.Insert filetoopen
Else
Charts.Add
ActiveChart.SetSourceData Source:=Sheets("data").Range
("a100")
ActiveChart.Location Whe=xlLocationAsObject,
Name:="Data"
With ActiveChart
.Pictures.Insert filetoopen
.ChartArea.Border.LineStyle = 0
.ChartArea.ClearContents
If .Shapes(1).Width .Shapes(1).Height Then
.Shapes(1).LockAspectRatio = msoFalse
ActiveChart.Shapes(1).Width = 142
ActiveChart.Shapes(1).Height = 97
Else
ActiveChart.Shapes(1).Height = 97
End If
lWidth = ActiveChart.Shapes(1).Width
lHeight = ActiveChart.Shapes(1).Height
End With
chtname = ActiveChart.Name
chtnametrim = Mid(chtname, 6, 20)
ActiveSheet.Shapes(chtnametrim).Width = lWidth 8
ActiveSheet.Shapes(chtnametrim).Height = lHeight 8
ActiveChart.Export strlocation, "GIF", False

ActiveChart.ChartArea.Select
Selection.Clear
With Sheets("data")
ActiveCell.Offset(0, -ActiveCell.Column 9).Select
..Pictures.Insert strlocation
End With
End If
End Sub
+++++++++++++++++++++++++++++++++++++++++++++++++ +++++++++
+
Snip