将多个图表传递给打印预览

我有多张图表作为对象。 我目前通过单独打印每个打印自动双面打印。 自动打印工作正常,但由于我正在做的所有格式,我觉得有点慢。

这是一组现在的打印macros,前三个是图表,最后一个打印输出是一个表格:

Sub Print99() Call Module1.Start Call METRICS.MetricsOpen Call Module1.ScrapProdOpen Sheets("99i").Select ActiveSheet.ChartObjects("99i").Activate With ActiveChart.PageSetup .LeftHeader = "" .CenterHeader = "" .RightHeader = "" .LeftFooter = "" .CenterFooter = "&D" .RightFooter = "" .LeftMargin = Application.InchesToPoints(0.1) .RightMargin = Application.InchesToPoints(0.1) .TopMargin = Application.InchesToPoints(0.1) .BottomMargin = Application.InchesToPoints(0.1) .HeaderMargin = Application.InchesToPoints(0.3) .FooterMargin = Application.InchesToPoints(0.3) .ChartSize = xlScreenSize .PrintQuality = 600 .CenterHorizontally = True .CenterVertically = False .Orientation = xlLandscape .FirstPage.RightFooter.Text = "" .PaperSize = xlPaperLetter .FirstPageNumber = xlAutomatic .BlackAndWhite = False .Zoom = 100 End With Application.PrintCommunication = True ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _ IgnorePrintAreas:=False Sheets("99p").Select ActiveSheet.ChartObjects("99p").Activate With ActiveChart.PageSetup .LeftHeader = "" .CenterHeader = "" .RightHeader = "" .LeftFooter = "" .CenterFooter = "&D" .RightFooter = "" .LeftMargin = Application.InchesToPoints(0.1) .RightMargin = Application.InchesToPoints(0.1) .TopMargin = Application.InchesToPoints(0.1) .BottomMargin = Application.InchesToPoints(0.1) .HeaderMargin = Application.InchesToPoints(0.3) .FooterMargin = Application.InchesToPoints(0.3) .ChartSize = xlScreenSize .PrintQuality = 600 .CenterHorizontally = True .CenterVertically = False .Orientation = xlLandscape .FirstPage.RightFooter.Text = "" .PaperSize = xlPaperLetter .FirstPageNumber = xlAutomatic .BlackAndWhite = False .Zoom = 100 End With Application.PrintCommunication = True ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _ IgnorePrintAreas:=False Sheets("99s").Select ActiveSheet.ChartObjects("99s").Activate With ActiveChart.PageSetup .LeftHeader = "" .CenterHeader = "" .RightHeader = "" .LeftFooter = "" .CenterFooter = "&D" .RightFooter = "" .LeftMargin = Application.InchesToPoints(0.1) .RightMargin = Application.InchesToPoints(0.1) .TopMargin = Application.InchesToPoints(0.1) .BottomMargin = Application.InchesToPoints(0.7) .HeaderMargin = Application.InchesToPoints(0.3) .FooterMargin = Application.InchesToPoints(0.3) .ChartSize = xlScreenSize .PrintQuality = 600 .CenterHorizontally = True .CenterVertically = False .Orientation = xlLandscape .FirstPage.RightFooter.Text = "" .PaperSize = xlPaperLetter .FirstPageNumber = xlAutomatic .BlackAndWhite = False .Zoom = 100 End With Application.PrintCommunication = True ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _ IgnorePrintAreas:=False Sheets("99w").Activate Application.PrintCommunication = True ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _ IgnorePrintAreas:=False Sheets("HOME").Activate Call Module1.CloseMetrics Call Module1.Finish End Sub 

我想将所有图表对象以及表格一起传递给打印预览,以便用户可以更好地控制打印。 我不确定如何从多个工作表中select对象,因此可能需要更改回以前的工作簿设置,其中图表是单个工作表,而不是粘贴在工作表上。

另一种方法是显着加快打印macros,但我也有一个Application.PrintCommunication = True的问题,它导致Excel 2007上的问题,但在Excel 2013上运行良好,并不是所有用户都在2013年。