vba 跨多个工作表应用格式

Apply Formating across multiple sheets

提问by Will

I have searched and tried multiple different codes and way out there, but have had no luck finding a solution. I am trying to take a macro setup to format one sheet, which works perfectly, and apply the same code to all sheets in the workbook. I have searched multiple codes and sheet array formulas but are unable to either apply them to the code I have or understand them enough to change what needs to be changed in order for them to work. I am fairly new to the macro world and do not understand the programming language at all. I appreciate anyone's time that they put into helping me on this as I have been struggling with this for several weeks now. Thank you. The following code is what i have thus far:

我已经搜索并尝试了多种不同的代码和方法，但没有找到解决方案。我正在尝试使用宏设置来格式化一张工作表，它完美地工作，并将相同的代码应用于工作簿中的所有工作表。我搜索了多个代码和工作表数组公式，但无法将它们应用于我拥有的代码，也无法充分理解它们以更改需要更改的内容以使它们工作。我对宏观世界相当陌生，根本不了解编程语言。我感谢任何人在这方面投入的时间帮助我，因为我已经为此苦苦挣扎了几个星期。谢谢你。以下代码是我迄今为止所拥有的：

Sub DARprintready()
'
' DARprintready Macro
'

'
    Columns("A:A").Select
    Selection.columnwidth = 2.86
    Columns("B:B").Select
    Selection.columnwidth = 4.57
    Columns("C:C").Select
    Selection.columnwidth = 13.57
    Columns("D:D").Select
    Selection.columnwidth = 8.57
    Columns("E:E").Select
    Selection.columnwidth = 20.86
    Columns("F:F").Select
    Selection.columnwidth = 8.43
    Columns("G:H").Select
    Selection.columnwidth = 9.43
    Columns("I:I").Select
    Selection.columnwidth = 9.14
    Columns("J:J").Select
    Selection.columnwidth = 9.43
    Columns("K:K").Select
    Selection.columnwidth = 50.4
    Columns("L:L").Select
    Selection.columnwidth = 9
    Range("E:E,K:K").Select
    Range("K1").Activate
    Selection.NumberFormat = "@"
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    ActiveWindow.SmallScroll Down:=-15
    Columns("A:L").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    ActiveWindow.SmallScroll Down:=-6
    Columns("A:A").Select
    ActiveWindow.SmallScroll Down:=-15
    Range("A1").Select
    Sheets("Header").Select
    Range("A1:L4").Select
    Selection.Copy
    Sheets("Firmwide").Select
    Rows("1:1").Select
    Selection.Insert Shift:=xlDown
    Application.CutCopyMode = False
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = "Page &P of &N"
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.18)
        .RightMargin = Application.InchesToPoints(0.16)
        .TopMargin = Application.InchesToPoints(0.17)
        .BottomMargin = Application.InchesToPoints(0.39)
        .HeaderMargin = Application.InchesToPoints(0.17)
        .FooterMargin = Application.InchesToPoints(0.16)
        .PrintHeadings = False
        .PrintGridlines = True
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperLetter
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 80
        .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
End Sub

回答by jonsca

To add a bit to the other answer, use a withstatement as a shorthand for all of your changes, so you don't have to keep typing the sheet name over and over

要为其他答案添加一点，请使用with语句作为所有更改的简写，这样您就不必一遍又一遍地输入工作表名称

Sub ColWidth()
    Dim wkst As Worksheet
    For Each wkst In ThisWorkbook.Sheets
        With wkst
            .Columns("A:A").ColumnWidth = 2.86
            .Columns("B:B").ColumnWidth = 4.57
            .Columns("C:C").ColumnWidth = 13.57
            .Columns("D:D").ColumnWidth = 8.57
        End With
    Next

End Sub

(you'll have to adopt the rest of it to this form)

（您必须将其余部分用于此表单）

Also, consider keeping your column widths in an array, and assigning them to the columns in a loop. It won't speed things up, but your code will be more compact, and, I think, readable.

此外，请考虑将列宽保留在数组中，并将它们分配给循环中的列。它不会加快速度，但你的代码会更紧凑，而且我认为可读。

E.g.,

例如，

Dim i As Integer
Dim widths() As Variant
widths = Array(4.5, 3.67, 5, 6.45, 10)

For i = 1 To 5
    Columns(i).ColumnWidth = widths(i) `Thank you iDevlop for the less Rube Goldberg approach
Next

That way, you can add more columns in at will without having to type everything out.

这样，您可以随意添加更多列，而无需输入所有内容。

回答by Pynner

Step 1 will be learning some VBA. Fortunately the task you are attempting doesn't require you to learn a tonne.

第 1 步将学习一些 VBA。幸运的是，您正在尝试的任务不需要您学习一吨。

Assuming that you need EXACTLY the same formatting on ALL sheets, you need to loop through the sheets.

假设您需要在所有工作表上使用完全相同的格式，您需要遍历工作表。

In order to do this you'll need to do 3 things.

为了做到这一点，你需要做 3 件事。

1. Create a variable for the target sheet name
2. Put your formatting inside a Loop that goes through each sheet
3. Replace the hardcoded sheet names in your macro with your variable name

1. 为目标工作表名称创建一个变量
2. 将您的格式放在遍历每张纸的循环中
3. 将宏中的硬编码工作表名称替换为变量名称

Your code will end up something like this

你的代码最终会是这样的

Sub DARprintready() ' ' DARprintready Macro '
dim Outputsheet as workhsheet

for each Outputsheet in activeworkbook.sheets

  outputsheet.select
  'your formatting code here


next

You'll need to change that explicit reference to the sheet firmwide with a reference to the variable you just created.

您需要使用对刚刚创建的变量的引用来更改对公司范围的工作表的显式引用。

replace this:

替换这个：

Sheets("Firmwide").Select

with this:

有了这个：

Outputsheet.Select

hope that helps,

希望有帮助，

回答by Jon49

As usual, I'm a little late, but here's a better solution. Feel free to mark mine as right if you feel it is a better solution. This way formats all the sheets at once avoiding the loop and is much faster since it is internal to Excel where the loops happen.

像往常一样，我来晚了一点，但这里有一个更好的解决方案。如果您觉得这是一个更好的解决方案，请随时将我的标记为正确。这种方式一次格式化所有工作表，避免循环并且速度更快，因为它是 Excel 内部发生循环的地方。

    Dim shs As Sheets, wks As Worksheet
    Dim rFormat As Range

    Set wks = ActiveWorkbook.Worksheets("Sheet1")
    Set shs = ActiveWorkbook.Sheets(Array("Sheet1", "Sheet2"))

    shs.Select

    Set rFormat = wks.Range("A1:A2,C3:C4")
    rFormat.Select
    With Selection
        .Font.ColorIndex = 3
        .Interior.ColorIndex = 6
        .Interior.Pattern = xlSolid
    End With

    wks.Select

回答by Patrick Honorez

For a quick method:

一个快速的方法：

   Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Select
   Columns("A:E").EntireColumn.AutoFit

回答by hornetbzz

The above code did not work in my case, because it was missing to activate one of the 3 (or more) worksheets to get formatted. Since I spent some time for solving this issue, I'm sharing that piece of code. Obviusliy this can be improved, for example using arrays also for the format patterns.

上面的代码在我的情况下不起作用，因为它缺少激活 3 个（或更多）工作表之一以进行格式化。由于我花了一些时间来解决这个问题，我正在分享那段代码。显然，这可以改进，例如也可以将数组用于格式模式。

Sub PivotTabsFormatting()
'
' PivotTabsFormatting Macro
' This formats a column range columns on multiple sheets
' Keyboard Shortcut: Ctrl+a
' By PhB- Dec'18
'
Dim shs As Sheets
Dim wks As Worksheet
Dim rFormat1 As Range
Dim rFormat2 As Range

    Set wks = ActiveWorkbook.Worksheets("Sheet1")
    Set shs = ActiveWorkbook.Sheets(Array("Sheet1", "Sheet2", "Sheet3"))
    Set rFormat1 = wks.Columns("D:O") 'could also be :  .Range("D4:M10")
    Set rFormat2 = wks.Columns("B:C") 'could also be :  .Range("B6:C6")

    shs.Select
    wks.Activate ' --> this was missing

    With rFormat1
        .ColumnWidth = 15
    End With

    With rFormat2
        .EntireColumn.AutoFit
    End With

    wks.Select
    wks.Range("A1").Select

End Sub