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

时间:2015-10-01 11:15:40

标签: excel excel-vba vba

我有多张图表作为对象。我目前通过单独打印每个打印这些,以绕过自动双面打印。自动打印工作正常但由于我正在进行的所有格式化都有点慢,我相信。

这是目前一组的打印宏,前三个是图表,最后一个打印输出是表格:

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

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

替代方法是显着加快打印宏的速度,但我也遇到Application.PrintCommunication = True的问题,它会导致Excel 2007出现问题但在Excel 2013上运行正常,并且并非所有用户都在2013年。< / p>

0 个答案:

没有答案