3个回答
展开全部
在文件夹下新建一个excel文件,新建个宏输入下面的vba代码,点运行宏,再把你新建的那个excel文件删除。
Sub 批量添加修改同目录下工作薄名称()
Dim f As String, wb As Workbook, th As Workbook, t As String, m As String, oldpath As String
Set th = ThisWorkbook
Application.ScreenUpdating = False '关闭刷屏
Application.DisplayAlerts = False '关闭警告和消息
f = Dir(th.Path & "\*.xls") '获取文件夹地址 许同一个版本:xls
t = InputBox("输入工作簿名称后需要添加的内容")
Do While f > " "
If f <> th.Name Then '判断是否为当前工作表
Set wb = Workbooks.Open(th.Path & "\" & f)
m = Left(f, InStrRev(f, ".") - 1)
wb.SaveAs (th.Path & "\" & m & t & ".xls") '保存为新工作薄
oldpath = th.Path & "\" & m & ".xls"
Kill (oldpath) '删除原工作簿
wb.Close
End If
f = Dir
Loop
Application.DisplayAlerts = True
Application.ScreenUpdating = True '恢复刷屏
End Sub
Sub 批量添加修改同目录下工作薄名称()
Dim f As String, wb As Workbook, th As Workbook, t As String, m As String, oldpath As String
Set th = ThisWorkbook
Application.ScreenUpdating = False '关闭刷屏
Application.DisplayAlerts = False '关闭警告和消息
f = Dir(th.Path & "\*.xls") '获取文件夹地址 许同一个版本:xls
t = InputBox("输入工作簿名称后需要添加的内容")
Do While f > " "
If f <> th.Name Then '判断是否为当前工作表
Set wb = Workbooks.Open(th.Path & "\" & f)
m = Left(f, InStrRev(f, ".") - 1)
wb.SaveAs (th.Path & "\" & m & t & ".xls") '保存为新工作薄
oldpath = th.Path & "\" & m & ".xls"
Kill (oldpath) '删除原工作簿
wb.Close
End If
f = Dir
Loop
Application.DisplayAlerts = True
Application.ScreenUpdating = True '恢复刷屏
End Sub
推荐律师服务:
若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询