Применить форматирование на нескольких листах

Question

Я искал и пробовал несколько разных кодов, но мне не повезло найти решение. Я пытаюсь выполнить настройку макроса для форматирования одного листа, который отлично работает, и применить один и тот же код ко всем листам в книге. Я искал несколько кодов и формул массива листов, но не могу ни применить их к имеющемуся у меня коду, ни понять их достаточно, чтобы изменить то, что нужно изменить, чтобы они работали. Я довольно плохо знаком с макро-миром и совсем не понимаю язык программирования. Я ценю чье-то время, которое они потратили на помощь мне в этом, так как я боролся с этим уже несколько недель. Спасибо. Следующий код - это то, что у меня есть:

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

Answer 1

Чтобы добавить немного к другому ответу, используйте оператор 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

(вам придется перенести все остальное в эту форму)

Кроме того, рассмотрите возможность сохранения ширины столбцов в массиве и назначения их столбцам в цикле.Это не ускорит процесс, но ваш код будет более компактным и, я думаю, читабельным.

Например,

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

Таким образом, вы можете добавить больше столбцов вбудет без необходимости вводить все.

Answer 2

Шаг 1 будет изучать некоторые VBA.К счастью, задача, которую вы пытаетесь выполнить, не требует, чтобы вы изучали тонну.

Предполагая, что вам необходимо ТОЧНО одинаковое форматирование на ВСЕХ листах, вам нужно пройтись по листам.для этого вам нужно сделать 3 вещи.

1. Создать переменную для имени целевого листа
2. Поместить форматирование в цикл, который проходит через каждый лист
3. Замените жестко закодированные имена листов в макросе на имя переменной

Ваш код в итоге будет выглядеть примерно так

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

for each Outputsheet in activeworkbook.sheets

  outputsheet.select
  'your formatting code here


next

Вам нужно будет изменить эту явную ссылку напо всей фирме со ссылкой на только что созданную переменную.

замените это:

Sheets("Firmwide").Select

на следующее:

Outputsheet.Select

надеюсь, что это поможет,

Answer 3

Как обычно, я немного опоздал, но вот лучшее решение.Не стесняйтесь пометить мой как правильный, если вы чувствуете, что это лучшее решение.Таким образом форматируются все листы одновременно, избегая зацикливания, и это происходит намного быстрее, поскольку это происходит внутри 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

Answer 4

Приведенный выше код не работал в моем случае, потому что не хватало для активации одного из 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

Answer 5

Для быстрого метода:

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