Convert Range To JPG (Resized)

[WayneK]

Hello. I'm using Excel 2000. And I am self-taught in using VBA
(somewhat !).

I was trying to develop the means to save a specified range as a
seperate,
external JPG file. After doing some research via the internet and some
experimentation, I came up with the code below. This code works fine
--
except -- when used on the range I need, it produces a "squished", out
of proportion picture on the JPG file. In essence, the Chart that is
added in
the code needs to be resized or rescaled prior to generating the JPG,
so that its appearance looks correct.

In attempting to to do something similar to this, I used the Macro
Recorder
to add a Sheet, then add a Chart to a Workbook, and then manually
resize
the Chart to the proportions I need. I then tried added the code
generated
by the macro Recorder to the other code below, but it does not work --
it
does not resize the Chart as I need.

Could you review (rethink ?) my code below and help me in this ? What
I'm
after is the means to resize the Chart using VBA (instead of manually)
so that the JPG file which is made from the Chart will be in the size
(proportions) I need.

Below will be the main code which solves 95% of the problem. After that
code
is additional code I have tried, hoping it would resize the Chart. I
include it
here, in that it may stimulate some of your thought, or perhaps I may
the
syntax wrong and if the correct syntax is used,that might work.

I truly appreciate any help in this.

Thank you.

Wayne

'---------------------------------------

Code:

Sub CreateJPGfromRange()
Dim Fn As String
Dim TPath As String, PName As String
Dim pic_rng As Range
Dim ShTemp As Worksheet
Dim ChTemp As Chart
Dim PicTemp As Picture
Dim ss As ChartObject

Application.ScreenUpdating = False

'Establish the Current FilePath
TPath = ThisWorkbook.Path & "\"

'Obtain the Pictures Filename from a cell
PName = Range("M15").Value & ".jpg"

Fn = TPath & PName

'Choose the Sheet and Range
Set pic_rng = Worksheets("Sales1").Range("J33:X73")

Set ShTemp = Worksheets.

Add Charts.Add

'note it is after the line above that code needs to be added
'for resizing, rescaling of the Chart

ActiveChart.Location Where:=xlLocationAsObject, Name:=ShTemp.Name
Set ChTemp = ActiveChart pic_rng.CopyPicture Appearance:=xlScreen,
Format:=xlPicture ChTemp.Paste

Set PicTemp = Selection

With ChTemp.Parent
..Width = PicTemp.Width + 8
..Height = PicTemp.Height + 8
End With

ChTemp.Export FileName:=Fn, FilterName:="jpg"

Application.DisplayAlerts = False
ShTemp.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

'-------------------------------------
'Some code lines which did NOT work

'Perhaps they can be modified/tweaked to work properly
'Perhaps I do not have the right syntax ?
Code:

'ActiveSheet.Shapes("Chart 1").ScaleWidth 1.3, msoFalse,
msoScaleFromTopLeft 'ActiveSheet.Shapes("Chart 1").ScaleHeight 3.62,
msoFalse, msoScaleFromTopLeft

'-------------------------------------

'more code that did not resize the Chart
Code:

'For Each ss In ActiveSheet.ChartObjects
'ss.Activate
'ActiveChart.PlotArea.Height = 720
'ActiveChart.PlotArea.Width = 576 'Next

'-------------------------------------

'more code that did not resize the Chart
Code:

'ActiveChart.PlotArea.Height = 360
'ActiveChart.PlotArea.Width = 360

'-------------------------------------

 

[Tom Ogilvy]

Did you try Harald's code as advised?