L
Legacy 404472
Guest
I have a workbook with multiple sheets. I want to export and save the same range on each sheet as a jpg, all to the same location, with the sheet name as the ultimate name of the jpg.
I've found code that allows me to save each sheet as its own xlsx and I've found code that allows me to export/save a range as a jpg. But I can't figure out out to do a combination of those two.
I am using Excel 2016.
Any help would be appreciated.
Here is the split code
Sub Splitbook()
MyPath = ThisWorkbook.Path
For Each sht In ThisWorkbook.Sheets
sht.Copy
ActiveSheet.Cells.Copy
ActiveSheet.Cells.PasteSpecial Paste:=xlPasteValues
ActiveSheet.Cells.PasteSpecial Paste:=xlPasteFormats
ActiveWorkbook.SaveAs _
Filename:=MyPath & "" & sht.Name & ".xlsx"
ActiveWorkbook.Close savechanges:=False
Next sht
End Sub
Here is the jpg code
Sub ExportNumChart()
Const FName As String = "C:\users\a***\Google Drive\Branch Scorecards\YTD Branch Scorecard.jpg"
Dim pic_rng As Range
Dim ShTemp As Worksheet
Dim ChTemp As Chart
Dim PicTemp As Picture
Application.ScreenUpdating = False
Set pic_rng = Worksheets("YTD").Range("B1:I53")
Set ShTemp = Worksheets.Add
Charts.Add
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 + 400
.Height = PicTemp.Height + 1100
End With
ChTemp.Export Filename:="C:\users\a***\Google Drive\Branch Scorecards\YTD Branch Scorecard.jpg", FilterName:="jpg"
'UserForm1.Image1.Picture = LoadPicture(FName)
'Kill FName
Application.DisplayAlerts = False
ShTemp.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
I've found code that allows me to save each sheet as its own xlsx and I've found code that allows me to export/save a range as a jpg. But I can't figure out out to do a combination of those two.
I am using Excel 2016.
Any help would be appreciated.
Here is the split code
Sub Splitbook()
MyPath = ThisWorkbook.Path
For Each sht In ThisWorkbook.Sheets
sht.Copy
ActiveSheet.Cells.Copy
ActiveSheet.Cells.PasteSpecial Paste:=xlPasteValues
ActiveSheet.Cells.PasteSpecial Paste:=xlPasteFormats
ActiveWorkbook.SaveAs _
Filename:=MyPath & "" & sht.Name & ".xlsx"
ActiveWorkbook.Close savechanges:=False
Next sht
End Sub
Here is the jpg code
Sub ExportNumChart()
Const FName As String = "C:\users\a***\Google Drive\Branch Scorecards\YTD Branch Scorecard.jpg"
Dim pic_rng As Range
Dim ShTemp As Worksheet
Dim ChTemp As Chart
Dim PicTemp As Picture
Application.ScreenUpdating = False
Set pic_rng = Worksheets("YTD").Range("B1:I53")
Set ShTemp = Worksheets.Add
Charts.Add
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 + 400
.Height = PicTemp.Height + 1100
End With
ChTemp.Export Filename:="C:\users\a***\Google Drive\Branch Scorecards\YTD Branch Scorecard.jpg", FilterName:="jpg"
'UserForm1.Image1.Picture = LoadPicture(FName)
'Kill FName
Application.DisplayAlerts = False
ShTemp.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub