Переберите все листы во всех книгах Excel в папке, чтобы изменить шрифт, размер шрифта и выравнивание текста во всех ячейках. - PullRequest
Новая
       18

Переберите все листы во всех книгах Excel в папке, чтобы изменить шрифт, размер шрифта и выравнивание текста во всех ячейках.

0 голосов
/ 05 марта 2012

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

Из моих собственных ограниченных знаний VBA и из чтениядругие связанные с этим вопросы здесь, так что я применил макрос ниже, который я сохранил в Personal.xls.

Как сейчас, кажется, что он перебирает книги, но не форматирует текст ни в одной из них.,

    Sub Format_Workbooks()

    'This macro requires that a reference to Microsoft Scripting Routine

    'be selected under Tools\References in order for it to work.

    Application.DisplayAlerts = False

    Application.ScreenUpdating = False

    Dim fso As New FileSystemObject

    Dim source As Scripting.Folder

    Dim wbFile As Scripting.File

    Dim book As Excel.Workbook

    Dim sheet As Excel.Worksheet

    Set source = fso.GetFolder("C:\Documents and Settings\The Thing\My Documents\Excel Workbooks")

    For Each wbFile In source.Files

    If fso.GetExtensionName(wbFile.Name) = "xls" Then

      Set book = Workbooks.Open(wbFile.Path)

      For Each sheet In book.Sheets

        With sheet       

        .Cells.Font.Name = "Whatever font I want to use"

        .Cells.Font.Size = 10

        .Cells.HorizontalAlignment = xlLeft

        End With

      Next

      book.Close

    End If

    Next

End Sub

Какие изменения мне нужно внести, чтобы макрос работал должным образом?

Кроме того, поскольку я никогда не использовал «подпрограмму сценариев Microsoft» до того, какинтересно, подходит ли мой подход к написанию этого макроса для моих заявленных целей или его следует переписать с нуля?

Спасибо за вашу помощь.

Ответы [ 2 ]

4 голосов
/ 05 марта 2012

Если типы файлов смешаны, вы можете получить увеличение производительности с помощью функции Dir, поскольку вы можете фильтровать тип файла, например:

Отредактировано в соответствии с предложениями Бретта 

Sub FormatFiles()
    Const fPath As String = "D:\My Documents\"
    Dim sh As Worksheet
    Dim sName As String

    With Application
        .Calculation = xlCalculationManual
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    sName = Dir(fPath & "*.xls*")

    Do Until sName = ""
        With GetObject(fPath & sName)
            For Each sh In .Worksheets
                With sh
                    .Cells.HorizontalAlignment = xlLeft
                    .Cells.Font.Name = "Tahoma"
                    .Cells.Font.Size = 10
                End With
            Next sh
            .Close True
        End With
        sName = Dir
    Loop

    With Application
        .Calculation = xlAutomatic
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub
1 голос
/ 05 марта 2012

Следующее утверждение означает, что вы не видите никаких предупреждений: 

Application.DisplayAlerts = False

Предупреждение, которое вы пропустили: 

book.Close

, который спрашивает, хотите ли вы сохранить сделанные вами изменения. Игнорируя этот вопрос, вы отвечаете «Нет».

Рекомендуемые действия:

  1. Удалить Application.DisplayAlerts = False
  2. Добавьте book.Save перед закрытием, если вы не хотите подтверждать каждое сохранение.
...