如何更好地格式化VBA中的所有工作表？
我有下面的代码将遍历worksheets workbook所有worksheets ，并将通过删除，更改页面方向，页边距格式化每个工作表，并能够打印在1纸张上的每个工作表。
下面它的工作，但它需要时间，因为Call editingProperties是相当长的，并需要时间来通过它的所有工作表。
有没有更好的方式来编写editingProperties子？
Dim ws As Worksheet Public Sub editAllSheets() ' Keyboard Shortcut: Ctrl+Shift+E ' Dim myResult As VbMsgBoxResult myResult = MsgBox("Are you sure you want to edit all sheets in this workbook?", vbQuestion + vbOKCancel + vbDefaultButton1, "Edit workbook") If myResult = vbCancel Then Exit Sub On Error GoTo ErrorHandler For Each ws In ActiveWorkbook.Worksheets ws.Activate Application.ScreenUpdating = False Call editingProperties Application.ScreenUpdating = True Next ws Sheets.Select MsgBox "Please note:" & vbNewLine & vbNewLine & "1. All the sheets are selected." & vbNewLine & "2. Proceed with print preview to view and print all reports." & vbNewLine & "3. To print preview or print only 1 report of this workbook you need to click on a different sheet to deselect all.", vbInformation, "Process Completed!" Exit Sub '<--- exit here if no error occured ErrorHandler: MsgBox "Sorry, an error occured." & vbCrLf & Err.Description, vbCritical, "Error!" End Sub Private Sub editingProperties() Columns("A:E").Select Range("A4").Activate Selection.UnMerge Columns("B:C").Select Selection.Delete Shift:=xlToLeft Columns("D:D").Select Selection.Delete Shift:=xlToLeft Columns("E:G").Select Selection.Delete Shift:=xlToLeft Columns("H:J").Select Selection.Delete Shift:=xlToLeft Columns("K:K").Select Selection.Delete Shift:=xlToLeft Range("A1:B2").Select Selection.Merge With ActiveSheet.PageSetup .PrintTitleRows = "" .PrintTitleColumns = "" End With ActiveSheet.PageSetup.PrintArea = "" With ActiveSheet.PageSetup .LeftHeader = "" .CenterHeader = "" .RightHeader = "" .LeftFooter = "" .CenterFooter = "" .RightFooter = "" .LeftMargin = Application.InchesToPoints(0.7) .RightMargin = Application.InchesToPoints(0.7) .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 With ActiveSheet.PageSetup .PrintTitleRows = "" .PrintTitleColumns = "" End With ActiveSheet.PageSetup.PrintArea = "" With ActiveSheet.PageSetup .LeftHeader = "" .CenterHeader = "" .RightHeader = "" .LeftFooter = "" .CenterFooter = "" .RightFooter = "" .LeftMargin = Application.InchesToPoints(0.25) .RightMargin = Application.InchesToPoints(0.25) .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 With ActiveSheet.PageSetup .PrintTitleRows = "" .PrintTitleColumns = "" End With ActiveSheet.PageSetup.PrintArea = "" With ActiveSheet.PageSetup .LeftHeader = "" .CenterHeader = "" .RightHeader = "" .LeftFooter = "" .CenterFooter = "" .RightFooter = "" .LeftMargin = Application.InchesToPoints(0.25) .RightMargin = Application.InchesToPoints(0.25) .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 = False .FitToPagesWide = 1 .FitToPagesTall = 1 .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 With ActiveSheet.PageSetup .PrintTitleRows = "" .PrintTitleColumns = "" End With ActiveSheet.PageSetup.PrintArea = "" With ActiveSheet.PageSetup .LeftHeader = "" .CenterHeader = "" .RightHeader = "" .LeftFooter = "" .CenterFooter = "" .RightFooter = "" .LeftMargin = Application.InchesToPoints(0.25) .RightMargin = Application.InchesToPoints(0.25) .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 = False .FitToPagesWide = 1 .FitToPagesTall = 1 .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 = "" Cells.Select Cells.EntireColumn.AutoFit Range("A3").Select End With End Sub
是的，您的代码现在正确地从右向左删除列。 我指出.Columns（“T：T”）与.Columns（20）中的.Columns（“T”）是一样的。
作为连续删除列的替代方法，您可以将它们合并为一个范围，然后删除范围，如下所示。
Dim Rng As Range With Ws Set Rng = Application.Union(.Columns("B:C"), _ .Columns("E:F"), _ .Columns("J:H"), _ .Columns("N:P"), _ .Columns("T")) Rng.Delete End With
请务必不要重复“With Ws …. End With”。重复不会造成损害，但会降低代码的可读性。
请看下面我的代码的结构。 我纠正了一些错误，做了一些改进，并开始了解如何编写一长串属性。 当你继续添加到列表中时，确保你不要复制所有的重复。 设置一次属性就足够了。
Public Sub EditAllSheets() ' 01 Apr 2017 ' Keyboard Shortcut: Ctrl+Shift+E Dim Ws As Worksheet Dim myResult As VbMsgBoxResult If MsgBox("Are you sure you want to edit all sheets in this workbook?", _ vbQuestion Or vbYesNo Or vbDefaultButton1, _ "Edit workbook") <> vbYes Then Exit Sub On Error GoTo ErrorHandler Application.ScreenUpdating = False For Each Ws In ActiveWorkbook.Worksheets EditProperties Ws Next Ws Sheets.Select MsgBox "Please note:" & vbCr & vbCr & _ "1. All the sheets are selected." & vbCr & _ "2. Proceed with print preview to view and print all reports." & vbCr & _ "3. To print preview or print only 1 report of this workbook" & vbCr & _ " you need to click on a different sheet to deselect all.", _ vbInformation, "Process Completed!" Application.ScreenUpdating = True Exit Sub '<--- exit here if no error occured ErrorHandler: MsgBox "Sorry, an error occured." & vbCrLf & Err.Description, vbCritical, "Error!" Application.ScreenUpdating = True End Sub Private Sub EditProperties(Ws As Worksheet) ' 01 Apr 2017 With Ws .Range(Columns(1), Columns(5)).UnMerge ' .Range(Columns("A"), Columns("E")).UnMerge ' can also work .Range(Columns(2), Columns(11)).Delete shift:=xlToLeft .Range("A1:B2").Merge With .PageSetup .PrintTitleRows = "" .PrintTitleColumns = "" .PrintArea = "" .LeftHeader = "" .CenterHeader = "" .RightHeader = "" .LeftFooter = "" .CenterFooter = "" .RightFooter = "" .LeftMargin = Application.InchesToPoints(0.7) .RightMargin = Application.InchesToPoints(0.7) .TopMargin = Application.InchesToPoints(0.75) .BottomMargin = Application.InchesToPoints(0.75) .HeaderMargin = Application.InchesToPoints(0.3) .FooterMargin = Application.InchesToPoints(0.3) .PrintHeadings = False End With End With End Sub