循环浏览文件夹中所有Excel工作簿中的所有工作表,以更改所有单元格中文本的字体,字体大小和alignment方式

在我的硬盘上我有一个文件夹包含一些Excel工作簿。 我想要遍历该文件夹中每个Excel工作簿中的所有工作表,以更改所有单元格中字体,字体大小和文本alignment方式。

从我自己有限的VBA知识和从这里阅读其他相关的问题,我已经拼凑了我已经存储在Personal.xls下面的macros。

现在,它似乎循环了工作簿,但它不是在任何文本格式化。

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 

我需要做些什么改变才能使macros观按照预期工作?

另外,因为我从来没有使用过“微软脚本程序”,所以在我想知道我写这个macros的方法是否对我所说的目标是正确的,还是应该从头开始重写呢?

谢谢你的帮助。

如果文件types混合在一起,则可以使用Dir函数来提高性能,因为您可以过滤文件types,如下所示:

按照Brett的build议编辑

 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 

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

 Application.DisplayAlerts = False 

您缺less的警告来自:

 book.Close 

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

build议的操作:

  1. 删除Application.DisplayAlerts = False
  2. 添加book.Save之前closures,除非你想确认每个保存。