循环浏览文件夹中所有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议的操作:
- 删除
Application.DisplayAlerts = False
- 添加
book.Save
之前closures,除非你想确认每个保存。