遍历文件夹中所有Excel工作簿中的所有工作表,以更改所有单元格中的文本的字体,字体大小和对齐方式

时间:2012-03-04 20:59:54

标签: vba loops worksheet excel

在我的硬盘上,我有一个包含许多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 个答案:

答案 0 :(得分:4)

如果文件类型是混合的,您可以使用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 :(得分:1)

以下声明表示您没有看到任何警告:

Application.DisplayAlerts = False

您缺少的警告来自:

book.Close

询问您是否要保存所做的更改。忽略这个问题,你回答“不”。

建议采取的行动:

  1. 删除Application.DisplayAlerts = False
  2. 在结束前添加book.Save,除非您要确认每次保存。