VBA Excel宏需要很长时间才能运行

时间：2020-11-06 00:28:25

标签： excel vba

我录制了一个Macro，它运行了一段时间了，但是随后开始运行得非常慢。之前大约需要10分钟才能运行，而大约需要30秒即可运行。如何使它再次快速运行？我不确定为什么现在运行缓慢。

基本上，它会更改工作表上的某些格式，在我的数据透视表上移动一些字段，选择每个班次并打印出来，然后将工作表恢复为原始格式。

Sub PostSchedule()
'
' PostSchedule Macro
'

'
    ActiveSheet.PivotTables("PivotTable1").PivotCache.Refresh
    ActiveWorkbook.SlicerCaches("Slicer_1_Sun").ClearManualFilter
    ActiveWorkbook.SlicerCaches("Slicer_2_Mon").ClearManualFilter
    ActiveWorkbook.SlicerCaches("Slicer_3_Tue").ClearManualFilter
    ActiveWorkbook.SlicerCaches("Slicer_4_Wed").ClearManualFilter
    ActiveWorkbook.SlicerCaches("Slicer_5_Thu").ClearManualFilter
    ActiveWorkbook.SlicerCaches("Slicer_6_Fri").ClearManualFilter
    ActiveWorkbook.SlicerCaches("Slicer_7_Sat").ClearManualFilter
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("Shift")
        .Orientation = xlRowField
        .position = 6
    End With
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("Trainer")
        .Orientation = xlRowField
        .position = 7
    End With
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("1 Sun")
        .Orientation = xlRowField
        .position = 8
    End With
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("2 Mon")
        .Orientation = xlRowField
        .position = 9
    End With
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("3 Tue")
        .Orientation = xlRowField
        .position = 10
    End With
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("4 Wed")
        .Orientation = xlRowField
        .position = 11
    End With
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("5 Thu")
        .Orientation = xlRowField
        .position = 12
    End With
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("6 Fri")
        .Orientation = xlRowField
        .position = 13
    End With
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("7 Sat")
        .Orientation = xlRowField
        .position = 14
    End With
    ActiveSheet.PivotTables("PivotTable1").PivotFields("LOA").Orientation = _
        xlHidden
    ActiveSheet.PivotTables("PivotTable1").PivotFields("Present").Orientation = _
        xlHidden
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
    End With
    Application.PrintCommunication = True
    ActiveSheet.PageSetup.PrintArea = ""
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .LeftHeader = "&""-,Bold""&18&U&K02-045????&U&K09+000 Crew Sheet"
        .CenterHeader = ""
        .RightHeader = "&D"
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = "&P of &N"
        .LeftMargin = Application.InchesToPoints(0.2)
        .RightMargin = Application.InchesToPoints(0.2)
        .TopMargin = Application.InchesToPoints(0.75)
        .BottomMargin = Application.InchesToPoints(0.75)
        .HeaderMargin = Application.InchesToPoints(0.3)
        .FooterMargin = Application.InchesToPoints(0.3)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperLetter
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 100
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = True
        .EvenPage.LeftHeader.Text = ""
        .EvenPage.CenterHeader.Text = ""
        .EvenPage.RightHeader.Text = ""
        .EvenPage.LeftFooter.Text = ""
        .EvenPage.CenterFooter.Text = ""
        .EvenPage.RightFooter.Text = ""
        .FirstPage.LeftHeader.Text = ""
        .FirstPage.CenterHeader.Text = ""
        .FirstPage.RightHeader.Text = ""
        .FirstPage.LeftFooter.Text = ""
        .FirstPage.CenterFooter.Text = ""
        .FirstPage.RightFooter.Text = ""
    End With
    Application.PrintCommunication = True
    ActiveWindow.SmallScroll Down:=-15
    With ActiveWorkbook.SlicerCaches("Slicer_Shift")
        .SlicerItems("12:00:00 AM").Selected = True
        .SlicerItems("12:30:00 AM").Selected = False
        .SlicerItems("1:30:00 AM").Selected = False
        .SlicerItems("4:00:00 AM").Selected = False
        .SlicerItems("8:00:00 AM").Selected = False
        .SlicerItems("8:30:00 AM").Selected = False
        .SlicerItems("10:00:00 AM").Selected = False
        .SlicerItems("11:00:00 AM").Selected = False
        .SlicerItems("11:30:00 AM").Selected = False
        .SlicerItems("12:30:00 PM").Selected = False
        .SlicerItems("3:00:00 PM").Selected = False
        .SlicerItems("4:00:00 PM").Selected = False
        .SlicerItems("11:00:00 PM").Selected = False
        .SlicerItems("11:30:00 PM").Selected = False
        .SlicerItems("(blank)").Selected = False
    End With
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
        IgnorePrintAreas:=False
    With ActiveWorkbook.SlicerCaches("Slicer_Shift")
        .SlicerItems("12:00:00 AM").Selected = False
        .SlicerItems("12:30:00 AM").Selected = True
        .SlicerItems("1:30:00 AM").Selected = False
        .SlicerItems("4:00:00 AM").Selected = False
        .SlicerItems("8:00:00 AM").Selected = False
        .SlicerItems("8:30:00 AM").Selected = False
        .SlicerItems("10:00:00 AM").Selected = False
        .SlicerItems("11:00:00 AM").Selected = False
        .SlicerItems("11:30:00 AM").Selected = False
        .SlicerItems("12:30:00 PM").Selected = False
        .SlicerItems("3:00:00 PM").Selected = False
        .SlicerItems("4:00:00 PM").Selected = False
        .SlicerItems("11:00:00 PM").Selected = False
        .SlicerItems("11:30:00 PM").Selected = False
        .SlicerItems("(blank)").Selected = False
    End With
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
        IgnorePrintAreas:=False
    With ActiveWorkbook.SlicerCaches("Slicer_Shift")
        .SlicerItems("12:00:00 AM").Selected = False
        .SlicerItems("12:30:00 AM").Selected = False
        .SlicerItems("1:30:00 AM").Selected = True
        .SlicerItems("4:00:00 AM").Selected = False
        .SlicerItems("8:00:00 AM").Selected = False
        .SlicerItems("8:30:00 AM").Selected = False
        .SlicerItems("10:00:00 AM").Selected = False
        .SlicerItems("11:00:00 AM").Selected = False
        .SlicerItems("11:30:00 AM").Selected = False
        .SlicerItems("12:30:00 PM").Selected = False
        .SlicerItems("3:00:00 PM").Selected = False
        .SlicerItems("4:00:00 PM").Selected = False
        .SlicerItems("11:00:00 PM").Selected = False
        .SlicerItems("11:30:00 PM").Selected = False
        .SlicerItems("(blank)").Selected = False
    End With
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
        IgnorePrintAreas:=False
    With ActiveWorkbook.SlicerCaches("Slicer_Shift")
        .SlicerItems("12:00:00 AM").Selected = False
        .SlicerItems("12:30:00 AM").Selected = False
        .SlicerItems("1:30:00 AM").Selected = Falsee
        .SlicerItems("4:00:00 AM").Selected = True
        .SlicerItems("8:00:00 AM").Selected = False
        .SlicerItems("8:30:00 AM").Selected = False
        .SlicerItems("10:00:00 AM").Selected = False
        .SlicerItems("11:00:00 AM").Selected = False
        .SlicerItems("11:30:00 AM").Selected = False
        .SlicerItems("12:30:00 PM").Selected = False
        .SlicerItems("3:00:00 PM").Selected = False
        .SlicerItems("4:00:00 PM").Selected = False
        .SlicerItems("11:00:00 PM").Selected = False
        .SlicerItems("11:30:00 PM").Selected = False
        .SlicerItems("(blank)").Selected = False
    End With
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
        IgnorePrintAreas:=False
    With ActiveWorkbook.SlicerCaches("Slicer_Shift")
        .SlicerItems("12:00:00 AM").Selected = False
        .SlicerItems("12:30:00 AM").Selected = False
        .SlicerItems("1:30:00 AM").Selected = Falsee
        .SlicerItems("4:00:00 AM").Selected = False
        .SlicerItems("8:00:00 AM").Selected = True
        .SlicerItems("8:30:00 AM").Selected = False
        .SlicerItems("10:00:00 AM").Selected = False
        .SlicerItems("11:00:00 AM").Selected = False
        .SlicerItems("11:30:00 AM").Selected = False
        .SlicerItems("12:30:00 PM").Selected = False
        .SlicerItems("3:00:00 PM").Selected = False
        .SlicerItems("4:00:00 PM").Selected = False
        .SlicerItems("11:00:00 PM").Selected = False
        .SlicerItems("11:30:00 PM").Selected = False
        .SlicerItems("(blank)").Selected = False
    End With
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
        IgnorePrintAreas:=False
    With ActiveWorkbook.SlicerCaches("Slicer_Shift")
        .SlicerItems("12:00:00 AM").Selected = False
        .SlicerItems("12:30:00 AM").Selected = False
        .SlicerItems("1:30:00 AM").Selected = Falsee
        .SlicerItems("4:00:00 AM").Selected = False
        .SlicerItems("8:00:00 AM").Selected = False
        .SlicerItems("8:30:00 AM").Selected = True
        .SlicerItems("10:00:00 AM").Selected = False
        .SlicerItems("11:00:00 AM").Selected = False
        .SlicerItems("11:30:00 AM").Selected = False
        .SlicerItems("12:30:00 PM").Selected = False
        .SlicerItems("3:00:00 PM").Selected = False
        .SlicerItems("4:00:00 PM").Selected = False
        .SlicerItems("11:00:00 PM").Selected = False
        .SlicerItems("11:30:00 PM").Selected = False
        .SlicerItems("(blank)").Selected = False
    End With
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
        IgnorePrintAreas:=False
    With ActiveWorkbook.SlicerCaches("Slicer_Shift")
        .SlicerItems("12:00:00 AM").Selected = False
        .SlicerItems("12:30:00 AM").Selected = False
        .SlicerItems("1:30:00 AM").Selected = Falsee
        .SlicerItems("4:00:00 AM").Selected = False
        .SlicerItems("8:00:00 AM").Selected = False
        .SlicerItems("8:30:00 AM").Selected = False
        .SlicerItems("10:00:00 AM").Selected = True
        .SlicerItems("11:00:00 AM").Selected = False
        .SlicerItems("11:30:00 AM").Selected = False
        .SlicerItems("12:30:00 PM").Selected = False
        .SlicerItems("3:00:00 PM").Selected = False
        .SlicerItems("4:00:00 PM").Selected = False
        .SlicerItems("11:00:00 PM").Selected = False
        .SlicerItems("11:30:00 PM").Selected = False
        .SlicerItems("(blank)").Selected = False
    End With
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
        IgnorePrintAreas:=False
    With ActiveWorkbook.SlicerCaches("Slicer_Shift")
        .SlicerItems("12:00:00 AM").Selected = False
        .SlicerItems("12:30:00 AM").Selected = False
        .SlicerItems("1:30:00 AM").Selected = Falsee
        .SlicerItems("4:00:00 AM").Selected = False
        .SlicerItems("8:00:00 AM").Selected = False
        .SlicerItems("8:30:00 AM").Selected = False
        .SlicerItems("10:00:00 AM").Selected = False
        .SlicerItems("11:00:00 AM").Selected = True
        .SlicerItems("11:30:00 AM").Selected = False
        .SlicerItems("12:30:00 PM").Selected = False
        .SlicerItems("3:00:00 PM").Selected = False
        .SlicerItems("4:00:00 PM").Selected = False
        .SlicerItems("11:00:00 PM").Selected = False
        .SlicerItems("11:30:00 PM").Selected = False
        .SlicerItems("(blank)").Selected = False
    End With
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
        IgnorePrintAreas:=False
    With ActiveWorkbook.SlicerCaches("Slicer_Shift")
        .SlicerItems("12:00:00 AM").Selected = False
        .SlicerItems("12:30:00 AM").Selected = False
        .SlicerItems("1:30:00 AM").Selected = Falsee
        .SlicerItems("4:00:00 AM").Selected = False
        .SlicerItems("8:00:00 AM").Selected = False
        .SlicerItems("8:30:00 AM").Selected = False
        .SlicerItems("10:00:00 AM").Selected = False
        .SlicerItems("11:00:00 AM").Selected = False
        .SlicerItems("11:30:00 AM").Selected = True
        .SlicerItems("12:30:00 PM").Selected = False
        .SlicerItems("3:00:00 PM").Selected = False
        .SlicerItems("4:00:00 PM").Selected = False
        .SlicerItems("11:00:00 PM").Selected = False
        .SlicerItems("11:30:00 PM").Selected = False
        .SlicerItems("(blank)").Selected = False
    End With
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
        IgnorePrintAreas:=False
    With ActiveWorkbook.SlicerCaches("Slicer_Shift")
        .SlicerItems("12:00:00 AM").Selected = False
        .SlicerItems("12:30:00 AM").Selected = False
        .SlicerItems("1:30:00 AM").Selected = Falsee
        .SlicerItems("4:00:00 AM").Selected = False
        .SlicerItems("8:00:00 AM").Selected = False
        .SlicerItems("8:30:00 AM").Selected = False
        .SlicerItems("10:00:00 AM").Selected = False
        .SlicerItems("11:00:00 AM").Selected = False
        .SlicerItems("11:30:00 AM").Selected = False
        .SlicerItems("12:30:00 PM").Selected = True
        .SlicerItems("3:00:00 PM").Selected = False
        .SlicerItems("4:00:00 PM").Selected = False
        .SlicerItems("11:00:00 PM").Selected = False
        .SlicerItems("11:30:00 PM").Selected = False
        .SlicerItems("(blank)").Selected = False
    End With
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
        IgnorePrintAreas:=False
    With ActiveWorkbook.SlicerCaches("Slicer_Shift")
        .SlicerItems("12:00:00 AM").Selected = False
        .SlicerItems("12:30:00 AM").Selected = False
        .SlicerItems("1:30:00 AM").Selected = Falsee
        .SlicerItems("4:00:00 AM").Selected = False
        .SlicerItems("8:00:00 AM").Selected = False
        .SlicerItems("8:30:00 AM").Selected = False
        .SlicerItems("10:00:00 AM").Selected = False
        .SlicerItems("11:00:00 AM").Selected = False
        .SlicerItems("11:30:00 AM").Selected = False
        .SlicerItems("12:30:00 PM").Selected = False
        .SlicerItems("3:00:00 PM").Selected = True
        .SlicerItems("4:00:00 PM").Selected = False
        .SlicerItems("11:00:00 PM").Selected = False
        .SlicerItems("11:30:00 PM").Selected = False
        .SlicerItems("(blank)").Selected = False
    End With
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
        IgnorePrintAreas:=False
    With ActiveWorkbook.SlicerCaches("Slicer_Shift")
        .SlicerItems("12:00:00 AM").Selected = False
        .SlicerItems("12:30:00 AM").Selected = False
        .SlicerItems("1:30:00 AM").Selected = Falsee
        .SlicerItems("4:00:00 AM").Selected = False
        .SlicerItems("8:00:00 AM").Selected = False
        .SlicerItems("8:30:00 AM").Selected = False
        .SlicerItems("10:00:00 AM").Selected = False
        .SlicerItems("11:00:00 AM").Selected = False
        .SlicerItems("11:30:00 AM").Selected = False
        .SlicerItems("12:30:00 PM").Selected = False
        .SlicerItems("3:00:00 PM").Selected = False
        .SlicerItems("4:00:00 PM").Selected = True
        .SlicerItems("11:00:00 PM").Selected = False
        .SlicerItems("11:30:00 PM").Selected = False
        .SlicerItems("(blank)").Selected = False
    End With
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
        IgnorePrintAreas:=False
    With ActiveWorkbook.SlicerCaches("Slicer_Shift")
        .SlicerItems("12:00:00 AM").Selected = False
        .SlicerItems("12:30:00 AM").Selected = False
        .SlicerItems("1:30:00 AM").Selected = Falsee
        .SlicerItems("4:00:00 AM").Selected = False
        .SlicerItems("8:00:00 AM").Selected = False
        .SlicerItems("8:30:00 AM").Selected = False
        .SlicerItems("10:00:00 AM").Selected = False
        .SlicerItems("11:00:00 AM").Selected = False
        .SlicerItems("11:30:00 AM").Selected = False
        .SlicerItems("12:30:00 PM").Selected = False
        .SlicerItems("3:00:00 PM").Selected = False
        .SlicerItems("4:00:00 PM").Selected = False
        .SlicerItems("11:00:00 PM").Selected = True
        .SlicerItems("11:30:00 PM").Selected = False
        .SlicerItems("(blank)").Selected = False
    End With
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
        IgnorePrintAreas:=False
    With ActiveWorkbook.SlicerCaches("Slicer_Shift")
        .SlicerItems("12:00:00 AM").Selected = False
        .SlicerItems("12:30:00 AM").Selected = False
        .SlicerItems("1:30:00 AM").Selected = Falsee
        .SlicerItems("4:00:00 AM").Selected = False
        .SlicerItems("8:00:00 AM").Selected = False
        .SlicerItems("8:30:00 AM").Selected = False
        .SlicerItems("10:00:00 AM").Selected = False
        .SlicerItems("11:00:00 AM").Selected = False
        .SlicerItems("11:30:00 AM").Selected = False
        .SlicerItems("12:30:00 PM").Selected = False
        .SlicerItems("3:00:00 PM").Selected = False
        .SlicerItems("4:00:00 PM").Selected = False
        .SlicerItems("11:00:00 PM").Selected = False
        .SlicerItems("11:30:00 PM").Selected = True
        .SlicerItems("(blank)").Selected = False
    End With
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
        IgnorePrintAreas:=False
    ActiveWorkbook.SlicerCaches("Slicer_Shift").ClearManualFilter
        With ActiveSheet.PivotTables("PivotTable1").PivotFields("1 Sun")
        .Orientation = xlRowField
        .position = 6
    End With
    ActiveSheet.PivotTables("PivotTable1").PivotFields("1 Sun").Orientation = _
        xlHidden
    ActiveSheet.PivotTables("PivotTable1").PivotFields("2 Mon").Orientation = _
        xlHidden
    ActiveSheet.PivotTables("PivotTable1").PivotFields("4 Wed").Orientation = _
        xlHidden
    ActiveSheet.PivotTables("PivotTable1").PivotFields("5 Thu").Orientation = _
        xlHidden
    ActiveSheet.PivotTables("PivotTable1").PivotFields("6 Fri").Orientation = _
        xlHidden
    ActiveSheet.PivotTables("PivotTable1").PivotFields("7 Sat").Orientation = _
        xlHidden
    ActiveSheet.PivotTables("PivotTable1").PivotFields("3 Tue").Orientation = _
        xlHidden
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("Trainer")
        .Orientation = xlRowField
        .position = 3
    End With
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("LOA")
        .Orientation = xlRowField
        .position = 7
    End With
        With ActiveSheet.PivotTables("PivotTable1").PivotFields("1 Sun")
        .Orientation = xlRowField
        .position = 8
    End With
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("Present")
        .Orientation = xlRowField
        .position = 9
    End With
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
    End With
    Application.PrintCommunication = True
    ActiveSheet.PageSetup.PrintArea = ""
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .LeftHeader = "&""-,Bold""&18&U&K02-045????&U&K09+000 Crew Sheet"
        .CenterHeader = ""
        .RightHeader = "&D"
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = "&P of &N"
        .LeftMargin = Application.InchesToPoints(0.2)
        .RightMargin = Application.InchesToPoints(0.2)
        .TopMargin = Application.InchesToPoints(0.75)
        .BottomMargin = Application.InchesToPoints(0.75)
        .HeaderMargin = Application.InchesToPoints(0.3)
        .FooterMargin = Application.InchesToPoints(0.3)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlPortrait
        .Draft = False
        .PaperSize = xlPaperLetter
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 100
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = True
        .EvenPage.LeftHeader.Text = ""
        .EvenPage.CenterHeader.Text = ""
        .EvenPage.RightHeader.Text = ""
        .EvenPage.LeftFooter.Text = ""
        .EvenPage.CenterFooter.Text = ""
        .EvenPage.RightFooter.Text = ""
        .FirstPage.LeftHeader.Text = ""
        .FirstPage.CenterHeader.Text = ""
        .FirstPage.RightHeader.Text = ""
        .FirstPage.LeftFooter.Text = ""
        .FirstPage.CenterFooter.Text = ""
        .FirstPage.RightFooter.Text = ""
    End With
    Application.PrintCommunication = True
    With ActiveWorkbook.SlicerCaches("Slicer_1_Sun")
        .SlicerItems("6am").Selected = True
        .SlicerItems("off").Selected = False
        .SlicerItems("x").Selected = True
        .SlicerItems("6th").Selected = True
        .SlicerItems("5th").Selected = True
        .SlicerItems("PTO").Selected = True
        .SlicerItems("(blank)").Selected = False
    End With
End Sub

1 个答案:

答案 0 :(得分：0)

这是未测试，但我希望它可以工作并且可以用于学习目的。

我重构了其中的一部分，以展示如何简化宏生成的代码。

在运行工作簿之前先对其进行备份。

通过按F8键运行它，并尝试检查它在哪里失败以及在哪里可能花费太长时间

'阅读评论并特别调整目标工作表名称

一些建议：

  • 在模块顶部添加Option Explicit，以便始终声明变量
  • 将您的代码分成逻辑步骤（我使用子过程使代码更具可读性）
  • 将变量命名为将来的自己或维护代码的人都会理解的

代码： 

Public Sub PostSchedule()
    '

    ' Basic error handling
    On Error GoTo CleanFail
    
    ' Turn off stuff
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    
    ' Reference workbook, worksheet and pivot table
    Dim targetWorkbook As Workbook
    Set targetWorkbook = ThisWorkbook
    
    Dim targetsheet As Worksheet
    Set targetsheet = targetWorkbook.Worksheets("Sheet1")
    
    Dim pivotTable1 As PivotTable
    Set pivotTable1 = targetsheet.PivotTables("PivotTable1")
    
    
    ' Refresh source data
    pivotTable1.PivotCache.Refresh
    
    ' Clear slicers filters
    With targetWorkbook
        .SlicerCaches("Slicer_1_Sun").ClearManualFilter
        .SlicerCaches("Slicer_2_Mon").ClearManualFilter
        .SlicerCaches("Slicer_3_Tue").ClearManualFilter
        .SlicerCaches("Slicer_4_Wed").ClearManualFilter
        .SlicerCaches("Slicer_5_Thu").ClearManualFilter
        .SlicerCaches("Slicer_6_Fri").ClearManualFilter
        .SlicerCaches("Slicer_7_Sat").ClearManualFilter
    End With
    
    ' Setup pivot fields
    With pivotTable1
        .PivotFields("Shift").Orientation = xlRowField
        .PivotFields("Shift").Position = 6
        
        .PivotFields("Trainer").Orientation = xlRowField
        .PivotFields("Trainer").Position = 7
        
        .PivotFields("1 Sun").Orientation = xlRowField
        .PivotFields("1 Sun").Position = 8
        
        .PivotFields("2 Mon").Orientation = xlRowField
        .PivotFields("2 Mon").Position = 9
        
        .PivotFields("3 Tue").Orientation = xlRowField
        .PivotFields("3 Tue").Position = 10
            
        .PivotFields("4 Wed").Orientation = xlRowField
        .PivotFields("4 Wed").Position = 11
        
        .PivotFields("5 Thu").Orientation = xlRowField
        .PivotFields("5 Thu").Position = 12
        
        .PivotFields("6 Fri").Orientation = xlRowField
        .PivotFields("6 Fri").Position = 13
            
        .PivotFields("7 Sat").Orientation = xlRowField
        .PivotFields("7 Sat").Position = 14
        
        .PivotFields("LOA").Orientation = xlHidden
        .PivotFields("Present").Orientation = xlHidden
        
    End With
    
    ' Setup sheet for printing
    SetupSheet targetsheet
    
    ' Ajust slicer and print
    Dim shiftSlicer As SlicerCache
    Set shiftSlicer = targetWorkbook.SlicerCaches("Slicer_Shift")
    AdjustAndPrint shiftSlicer, targetsheet
    
    
    ' This part you can adjust it based on the other sub samples
    DoOtherStuff
    

CleanExit:
    ' Turn on stuff
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Exit Sub
 
CleanFail:
    Debug.Print "Something went wrong: " & Err.Description
    Resume CleanExit
    
End Sub

Private Sub SetupSheet(ByVal targetsheet As Worksheet)

    Application.PrintCommunication = False
    
    With targetsheet.PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
        .PrintArea = ""
        
        ' Other page properties
        .LeftHeader = "&""-,Bold""&18&U&K02-045????&U&K09+000 Crew Sheet"
        .CenterHeader = ""
        .RightHeader = "&D"
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = "&P of &N"
        .LeftMargin = Application.InchesToPoints(0.2)
        .RightMargin = Application.InchesToPoints(0.2)
        .TopMargin = Application.InchesToPoints(0.75)
        .BottomMargin = Application.InchesToPoints(0.75)
        .HeaderMargin = Application.InchesToPoints(0.3)
        .FooterMargin = Application.InchesToPoints(0.3)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperLetter
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 100
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = True
        .EvenPage.LeftHeader.Text = ""
        .EvenPage.CenterHeader.Text = ""
        .EvenPage.RightHeader.Text = ""
        .EvenPage.LeftFooter.Text = ""
        .EvenPage.CenterFooter.Text = ""
        .EvenPage.RightFooter.Text = ""
        .FirstPage.LeftHeader.Text = ""
        .FirstPage.CenterHeader.Text = ""
        .FirstPage.RightHeader.Text = ""
        .FirstPage.LeftFooter.Text = ""
        .FirstPage.CenterFooter.Text = ""
        .FirstPage.RightFooter.Text = ""
    End With
    
    Application.PrintCommunication = True
    
End Sub

Private Sub AdjustAndPrint(ByVal shiftSlicer As SlicerCache, ByVal targetsheet As Worksheet)

    Dim slicerItemNames As Variant
    slicerItemNames = Array("12:00:00 AM", _
                        "12:30:00 AM", _
                        "1:30:00 AM", _
                        "4:00:00 AM", _
                        "8:00:00 AM", _
                        "8:30:00 AM", _
                        "10:00:00 AM", _
                        "11:00:00 AM", _
                        "11:30:00 AM", _
                        "12:30:00 AM", _
                        "3:00:00 PM", _
                        "4:00:00 PM", _
                        "11:00:00 PM", _
                        "11:30:00 PM", _
                        "(blank)")
    
    ' Loop through items, select and print
    Dim counter As Long
    For counter = 0 To UBound(slicerItemNames)
        
        ' Skip the blank
        If slicerItemNames(counter) = "(blank)" Then Exit For
        
        ' Inner loop to select each slicer once
        Dim innerCounter As Long
        For innerCounter = 0 To UBound(slicerItemNames)
            shiftSlicer.slicerItems(slicerItemNames(counter)).Selected = (counter = innerCounter)
        Next innerCounter
        
        ' Print each iteration
        targetsheet.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
        
    Next counter

    ' Clear slicer filter
    shiftSlicer.ClearManualFilter

End Sub

Private Sub DoOtherStuff()

    With ActiveSheet.PivotTables("PivotTable1").PivotFields("1 Sun")
        .Orientation = xlRowField
        .Position = 6
    End With
    ActiveSheet.PivotTables("PivotTable1").PivotFields("1 Sun").Orientation = _
        xlHidden
    ActiveSheet.PivotTables("PivotTable1").PivotFields("2 Mon").Orientation = _
        xlHidden
    ActiveSheet.PivotTables("PivotTable1").PivotFields("4 Wed").Orientation = _
        xlHidden
    ActiveSheet.PivotTables("PivotTable1").PivotFields("5 Thu").Orientation = _
        xlHidden
    ActiveSheet.PivotTables("PivotTable1").PivotFields("6 Fri").Orientation = _
        xlHidden
    ActiveSheet.PivotTables("PivotTable1").PivotFields("7 Sat").Orientation = _
        xlHidden
    ActiveSheet.PivotTables("PivotTable1").PivotFields("3 Tue").Orientation = _
        xlHidden
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("Trainer")
        .Orientation = xlRowField
        .Position = 3
    End With
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("LOA")
        .Orientation = xlRowField
        .Position = 7
    End With
        With ActiveSheet.PivotTables("PivotTable1").PivotFields("1 Sun")
        .Orientation = xlRowField
        .Position = 8
    End With
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("Present")
        .Orientation = xlRowField
        .Position = 9
    End With
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
    End With
    Application.PrintCommunication = True
    ActiveSheet.PageSetup.PrintArea = ""
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .LeftHeader = "&""-,Bold""&18&U&K02-045????&U&K09+000 Crew Sheet"
        .CenterHeader = ""
        .RightHeader = "&D"
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = "&P of &N"
        .LeftMargin = Application.InchesToPoints(0.2)
        .RightMargin = Application.InchesToPoints(0.2)
        .TopMargin = Application.InchesToPoints(0.75)
        .BottomMargin = Application.InchesToPoints(0.75)
        .HeaderMargin = Application.InchesToPoints(0.3)
        .FooterMargin = Application.InchesToPoints(0.3)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlPortrait
        .Draft = False
        .PaperSize = xlPaperLetter
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 100
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = True
        .EvenPage.LeftHeader.Text = ""
        .EvenPage.CenterHeader.Text = ""
        .EvenPage.RightHeader.Text = ""
        .EvenPage.LeftFooter.Text = ""
        .EvenPage.CenterFooter.Text = ""
        .EvenPage.RightFooter.Text = ""
        .FirstPage.LeftHeader.Text = ""
        .FirstPage.CenterHeader.Text = ""
        .FirstPage.RightHeader.Text = ""
        .FirstPage.LeftFooter.Text = ""
        .FirstPage.CenterFooter.Text = ""
        .FirstPage.RightFooter.Text = ""
    End With
    Application.PrintCommunication = True
    With ActiveWorkbook.SlicerCaches("Slicer_1_Sun")
        .slicerItems("6am").Selected = True
        .slicerItems("off").Selected = False
        .slicerItems("x").Selected = True
        .slicerItems("6th").Selected = True
        .slicerItems("5th").Selected = True
        .slicerItems("PTO").Selected = True
        .slicerItems("(blank)").Selected = False
    End With
End Sub

您要进行大量打印，因此还要检查打印机通信是否会影响您的宏运行时间。

让我知道怎么回事

相关问题
最新问题