使用 VBN 来 批量修改多个 Excel 的表格格式

Posted 2020-11-26 尘世俗人

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