如何更好地格式化VBA中的所有工作表？

我有下面的代碼，將遍歷所有worksheets的workbook，並將通過刪除，更改頁面方向，頁邊距格式化每個工作表，並能夠在1張紙上打印每張紙。如何更好地格式化VBA中的所有工作表？

下面它的工作，但它需要時間，因爲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

來源

2017-04-01 QuickSilver

我檢舉此問題作爲題外話，因爲它應按照此處的規定遷移到CodeReview：http://meta.stackoverflow.com/questions/266749/migration-of-code-questions-from-stack-overflow-to-code-review原因是：代碼正在工作， OP本人只是要求「更好的方法」（改進），但不是爲了克服錯誤或實施新的東西。 – Ralph

是的，您的代碼現在可以正確刪除從右到左的列。我指出.Columns（「T：T」）與.Columns（「T」）相同.Columns（20）相同。

作爲連續刪除列的替代方法，您可以將它們合併爲一個範圍，然後刪除範圍，如下所示。

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

一定不要重複「使用WS ....結束與。重複不傷害，但它從代碼的可讀性減損。

來源

2017-04-03 08:48:58 Variatus

非常感謝你的幫助我仍然在學習過程中，所以上面的代碼對我來說是新的感謝你分享你的知識。 – QuickSilver

請看下面我的代碼結構。我糾正了一些錯誤，做了一些改進，並開始瞭解如何編寫一長串屬性。當你繼續添加到列表中時，確保你不要複製所有的重複。設置一次屬性就足夠了。

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

來源

2017-04-01 13:17:44 Variatus

感謝您的幫助，但我已經嘗試了上面的代碼，在第一張表完成後，它將會第二張紙並擊中錯誤處理程序對象的方法範圍_Worksheet失敗。 – QuickSilver

發現我認爲的錯誤，因爲每個工作表需要在編輯前被激活。請讓我知道你的想法。我可以選擇所有紙張並同時編輯它們嗎？ – QuickSilver

不需要 - 實際上，您不需要 - 激活任何工作表。循環「接受」一個接一個的表格並將其稱爲「Ws」，並且它是您在子例程中工作的變量「Ws」 - 永遠不是ActiveSheet。您的錯誤處理程序會告訴您發生的錯誤的編號和描述。您可能想要禁用錯誤處理程序，讓VBA突出顯示導致它的代碼行。它可能在子程序中。然後你處理這個錯誤。如果你需要幫助，讓我知道你得到了什麼錯誤。 – Variatus

如何更好地格式化VBA中的所有工作表？

回答

相關問題