P
Pops Jackson
Tom Ogilvy posted the following code some time back and it works wonderfully
in Excel 2003 but, of course, encounters problems in 2007. Can anyone give
suggestions for bringing it up to date for 2007?
Sub ExportPicAsJpg()
Dim chTemp As Chart
Dim picCopy As Picture
Dim dWidth As Double
Dim dHeight As Double
Dim shNew As Worksheet
Set picCopy = Selection
Set chTemp = Charts.Add
Set shNew = Sheets.Add
dWidth = picCopy.Width
dHeight = picCopy.Height
Application.ScreenUpdating = False
With chTemp
.SetSourceData Source:=Sheets("Sheet1").Range("FA16383")
.Location Where:=xlLocationAsObject, Name:=shNew.Name
With shNew.ChartObjects(1)
.Width = dWidth + 2
.Height = dHeight + 2
.Top = 0
.Left = 0
Range("A1").Select
picCopy.Copy
.Activate
ActiveChart.Paste
.Interior.ColorIndex = 1
ActiveChart.Export "c:\TempPic.JPG", "jpg"
End With
End With
Application.DisplayAlerts = False
shNew.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Thanks for any help given,
in Excel 2003 but, of course, encounters problems in 2007. Can anyone give
suggestions for bringing it up to date for 2007?
Sub ExportPicAsJpg()
Dim chTemp As Chart
Dim picCopy As Picture
Dim dWidth As Double
Dim dHeight As Double
Dim shNew As Worksheet
Set picCopy = Selection
Set chTemp = Charts.Add
Set shNew = Sheets.Add
dWidth = picCopy.Width
dHeight = picCopy.Height
Application.ScreenUpdating = False
With chTemp
.SetSourceData Source:=Sheets("Sheet1").Range("FA16383")
.Location Where:=xlLocationAsObject, Name:=shNew.Name
With shNew.ChartObjects(1)
.Width = dWidth + 2
.Height = dHeight + 2
.Top = 0
.Left = 0
Range("A1").Select
picCopy.Copy
.Activate
ActiveChart.Paste
.Interior.ColorIndex = 1
ActiveChart.Export "c:\TempPic.JPG", "jpg"
End With
End With
Application.DisplayAlerts = False
shNew.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Thanks for any help given,