Code: Select all
Sub chght()
‘ Activate the first sheet that contains a chart
Worksheets("TMIN").Activate
‘ Select that chart for copy
ActiveSheet.ChartObjects(1).Copy
‘ Select the destination sheet, location, and paste it
Worksheets("PrtCht").Activate
Range("A1").Select
ActiveSheet.Paste
‘ Set height of the chart just pasted
ActiveSheet.ChartObjects(1).Height = 148
‘ the following five routines do the same with a chart on a different sheet
Worksheets("R50").Activate
ActiveSheet.ChartObjects(1).Copy
Worksheets("PrtCht").Activate
Range("A13").Select
ActiveSheet.Paste
ActiveSheet.ChartObjects(2).Height = 148
Worksheets("TMAX").Activate
ActiveSheet.ChartObjects(1).Copy
Worksheets("PrtCht").Activate
Range("A25").Select
ActiveSheet.Paste
ActiveSheet.ChartObjects(3).Height = 148
Worksheets("SP GR").Activate
ActiveSheet.ChartObjects(1).Copy
Worksheets("PrtCht").Activate
Range("A37").Select
ActiveSheet.Paste
ActiveSheet.ChartObjects(4).Height = 148
Worksheets("ML4").Activate
ActiveSheet.ChartObjects(1).Copy
Worksheets("PrtCht").Activate
Range("A49").Select
ActiveSheet.Paste
ActiveSheet.ChartObjects(5).Height = 148
Worksheets("MS").Activate
ActiveSheet.ChartObjects(1).Copy
Worksheets("PrtCht").Activate
Range("A61").Select
ActiveSheet.Paste
ActiveSheet.ChartObjects(6).Height = 148
‘ this selects a cell so there is no chart selected when going into the print routine
Range("A73").Select
‘ this code seems to do nothing since the preview shows across multiple sheets the first time
With ActiveSheet.PageSetup
.FitToPagesWide = 1
.FitToPagesTall = 1
.PrintErrors = xlPrintErrorsDisplayed
End With
‘ Preview charts on screen
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Preview:=True, Collate:=True
‘ Select the destination sheet and delete the charts now that we are through with them
Worksheets("PrtCht").Activate
ActiveSheet.ChartObjects(6).Delete
ActiveSheet.ChartObjects(5).Delete
ActiveSheet.ChartObjects(4).Delete
ActiveSheet.ChartObjects(3).Delete
ActiveSheet.ChartObjects(2).Delete
ActiveSheet.ChartObjects(1).Delete
End Sub