在我的硬盘上,我有一个包含许多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脚本例程”?
感谢您的帮助。
答案 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
询问您是否要保存所做的更改。忽略这个问题,你回答“不”。
建议采取的行动:
Application.DisplayAlerts = False
book.Save
,除非您要确认每次保存。