返回目录：excel表格制作
先给大家看实例效果吧：
开始我们的制作过程啦。
首先新建EXCEL工作簿，在一个工作表中按照如下输入设置：
一： A2单元格输入文字：文件夹路径；C2单元格输入文字：读取文件名后，请设置好新文件名后再执行文件重命名操作
二： A3:C3合并单元格
三： A4:C4合并单元格，并输入分割线（主要考虑视觉效果及VBA运行排除空行）
四： A5单元格输入文字：遍历文件夹下所有文件名
五： B5单元格输入文字：文件类型
六： C5单元格输入文字：设置新文件名（默认为原名）
七： 按照下图步骤，将文末的代码复制写入模块中：
八： 选择A1单元格，在开发工具选项卡中，选择插入菜单中的按钮（窗体控件），制作三个按钮控件，设置文字为初始化（选择指定名为“初始化”的宏），读取文件名（选择指定名为“读取文件名”的宏），文件改名（选择指定名为“文件重命名”的宏）。
九： 开始自由改名啦，体验一下自己的劳动成果吧。解放你的双手，大大提高效率。
如果喜欢，请点赞并关注一下。不想再动手的话，就私信我索要文档吧。
请把此文章分享给你的朋友们。
Sub 读取文件名()
ActiveSheet.Rows("6:10000").Select
Selection.Delete Shift:=xlUp
ActiveSheet.Range("A6").Select
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
If .Show = -1 Then
[a3] = .SelectedItems(1)
End If
End With
Dim myPath$, i%
myPath = Dir([a3] & "\\*.*")
Do While myPath <> ""
i = i + 1
Cells(i + 5, 1) = Left(myPath, InStrRev(myPath, ".") - 1)
Cells(i + 5, 2) = Mid(myPath, InStrRev(myPath, "."), 9)
Cells(i + 5, 3) = Left(myPath, InStrRev(myPath, ".") - 1)
myPath = Dir
Loop
End Sub
Sub 文件重命名()
filePath = [a3]
On Error Resume Next
n = 6
While Not IsEmpty(Cells(n, 1))
oldName = Cells(n, 1) & Cells(n, 2)
newNname = Cells(n, 3) & Cells(n, 2)
If Dir(filePath & "\\" & oldName) = "" Then
MsgBox "请重新读取文件名！"
Exit Sub
ElseIf n < ActiveSheet.Range("A" & Rows.Count).End(3).Row Then
Name filePath & "\\" & oldName As filePath & "\\" & newNname
ElseIf n = ActiveSheet.Range("A" & Rows.Count).End(3).Row Then
Name filePath & "\\" & oldName As filePath & "\\" & newNname
MsgBox "重命名成功"
ActiveWorkbook.Save
Exit Sub
End If
n = n + 1
Wend
End Sub
Sub 初始化()
Range("a3").Select
Selection.ClearContents
ActiveSheet.Rows("6:10000").Select
Selection.Delete Shift:=xlUp
ActiveSheet.Range("A6").Select
ActiveWorkbook.Save
End Sub