Excel 怎么把工作簿里的工作表名称换成工作簿名

本帖最后由 獨一無2 于 2018-7-20 12:12 编辑



Sub Rename()

    Dim kLoop, wk As Workbook, FilePath As String

    FilePath = ThisWorkbook.Path + "\"

   

    Application.ScreenUpdating = False

    For Each kLoop In GetFileList(FilePath).Items
        Set wk = Application.Workbooks.Open(kLoop)

        wk.Worksheets(1).Name = wk.Name

        wk.Close True

    Next kLoop

   

    Application.ScreenUpdating = True

End Sub



Private Function GetFileList(ByVal FilePath As String) As Dictionary

    Dim FileDic As New Dictionary

    Dim FileName As String

    Dim i As Integer

    i = 0

   

    FileName = Dir(FilePath & "*.xls")



    Do While FileName <> ""

        FileDic(i) = FilePath + FileName

        i = i + 1

        FileName = Dir

        If FileName = "" Then

            Exit Do

        End If

    Loop

   

    Set GetFileList = FileDic

End Function

除了宏所在的excel不能更新外，其余都能Rename.请提前勾选 VB->Tools->References->Microsoft Scripting Runtime 库