Справка по макросам Excel - Стек макросов

Я использую следующую подпрограмму для объединения нескольких файлов Excel из одной папки в одну книгу с несколькими листами.

Sub Merge2MultiSheets()

Dim wbDst As Workbook
Dim wbSrc As Workbook
Dim wsSrc As Worksheet
Dim MyPath As String
Dim strFilename As String

Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False
MyPath = "C:\MyPath" ' <-- Insert Absolute Folder Location
Set wbDst = Workbooks.Add(xlWBATWorksheet)
strFilename = Dir(MyPath & "\*.xls", vbNormal)

If Len(strFilename) = 0 Then Exit Sub

Do Until strFilename = ""            
    Set wbSrc = Workbooks.Open(Filename:=MyPath & "\" & strFilename)                
    Set wsSrc = wbSrc.Worksheets(1)                
    wsSrc.Copy After:=wbDst.Worksheets(wbDst.Worksheets.Count)                
    wbSrc.Close False            
    strFilename = Dir()            
Loop
wbDst.Worksheets(1).Delete

Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

Конечным продуктом является файл Excel с несколькими рабочими листами (а также один пустой Лист 1). Мне было интересно, как я могу применить другой макрос к этой недавно созданной книге. Например, я хочу, чтобы все рабочие листы в этой новой рабочей книге имели заголовки жирным шрифтом и были окрашены определенным образом, а пустой рабочий лист был удален.

eg:

Sub Headers()

Rows("1:1").Select
Selection.Font.Bold = True
With Selection.Interior
    .ColorIndex = 37
    .Pattern = xlSolid
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
End With

End Sub

excel vba excel-2003
person Sam    schedule 14.12.2010    source источник

Ответы (3)


arrow_upward
0
arrow_downward

Добавьте в заголовки параметр, указывающий лист, а затем вызовите подпрограмму где-нибудь в цикле выполнения после копирования, например:

Call Headers(wbDst.Worksheets(wbDst.Worksheets.Count))

со вторым субмариной, выглядящим так:

Sub Headers(workingSheet As Worksheet)

workingSheet.Rows("1:1").Select
Selection.Font.Bold = True
With Selection.Interior
.
.
.
person Lance Roberts    schedule 14.12.2010

arrow_upward
0
arrow_downward

Этот код будет делать следующее:

1) Во-первых, удалите Sheet1, как вы просили в своем посте.

2) Формат верхней строки в остальных листах

Sub Headers()
Dim wkSheet As Worksheet

//Delete Sheet1. Note that alerts are turned off otherwise you are prompted with a dialog box to check you want to delete sheet1
Application.DisplayAlerts = False
Worksheets("Sheet1").Delete
Application.DisplayAlerts = False

//Loop through each worksheet in workbook sheet collection
For Each wkSheet In ActiveWorkbook.Worksheets
    With wkSheet.Rows("1:1")
        .Interior.ColorIndex = 37
        //Add additional formatting requirements here
    End With
Next

End Sub
person Alex P    schedule 14.12.2010
comment
Нет необходимости перелистывать рабочие листы. Просто ГРУППИРУЙ их, выполняй задание, а затем РАЗГРУППИРУЙ их. - person Patrick Honorez; 14.12.2010
comment
@iDevlop - можете ли вы показать мне какой-нибудь код для этого? Я думал, что для группировки в VBA вам нужно создать массив рабочих листов, например. Листы (Массив (Лист1, Лист2, Лист3)) но мне кажется, что для этого вам сначала нужно будет пройтись по каждому листу в книге, чтобы создать массив? - person Alex P; 14.12.2010

arrow_upward

arrow_downward

person    schedule
comment
iDevlop — я согласен, что это работает, но моя точка зрения заключалась в том, что вам нужно жестко закодировать ссылки на листы, и вы предполагаете, что есть только три листа с именами Sheet1, Sheet2 и Sheet3. Чтобы сделать код максимально пригодным для повторного использования (т.е. обрабатывать неопределенное количество листов и имен), вы не можете избежать циклического просмотра листов... - person Alex P; 14.12.2010
comment
@Remnant: я согласен с вашим возражением. У меня сейчас нет времени, но я постараюсь показать правильный путь. Я совершенно уверен, что сделал это некоторое время назад, сославшись на первый и последний листы (которые вы можете идентифицировать). Просто нужно найти как... или признать, что я не прав ;-) - person Patrick Honorez; 14.12.2010
comment
что было бы хорошо, если бы в VBA было что-то вроде ActiveWorkbook.Worksheets.Group. Кстати, не смотрите на то, кто прав, а кто неправ... речь идет о том, чтобы помогать друг другу учиться, и я был бы рад, если бы вы могли показать мне более эффективный способ кодирования! - person Alex P; 15.12.2010
comment
@Remnant: нашел хотя бы один способ выбрать все листы сразу :-)) См. редактирование - person Patrick Honorez; 15.12.2010