Sub BatchChangeFormatOfExcel()
Dim time1 As Date
Dim time2 As Date
time1 = Timer ' 计时
Dim xFd As FileDialog
Dim xSPath As String
Dim xExcelFile As String
Application.DisplayAlerts = False
Application.StatusBar = True
Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
xFd.Title = "Select a folder:"
If xFd.Show = -1 Then
xSPath = xFd.SelectedItems(1)
Else
Exit Sub
End If
If Right(xSPath, 1) <> "\" Then xSPath = xSPath + "\"
xExcelFile = Dir(xSPath & "*.xlsx")
Do While xExcelFile <> ""
Application.StatusBar = "Changing: " & xExcelFile
' 打开表格
Dim wB As Workbook
Set wB = Workbooks.Open(Filename:=xSPath & xExcelFile)
Dim myRange As Range
Dim myFont As Font
' 获取表格及要修改的列
Set myRange = wB.Worksheets("Sheet1").Range("A1:E1")
myRange.Merge ' 合并
Set myFont = myRange.Font ' 获取字体
With myFont ' 修改字体
.Name = "华文新魏"
.Size = 20
.Bold = True
End With
' 居中显示
myRange.HorizontalAlignment = xlCenter
' 设置列格式
wB.Worksheets("Sheet1").Range("A:D").EntireColumn.NumberFormatLocal = "0000.000"
' 保存并关闭
wB.Save
wB.Close
' 获取下一个xlsx文件
xExcelFile = Dir
Loop
Application.StatusBar = False
Application.DisplayAlerts = True
' 处理完毕提示,及总耗时
time2 = Timer
MsgBox "Finished!" & " Cost Time: " & Format(time2 - time1, "Fixed") & " s."
End Sub