Question

EXCEL点击按钮后自动另存文件至指定目录并重命名

Private Sub CommandButton1_Click()
a = Sheets("光板").Range("H1").Value '
If a = "" Then
a = 0 '赋值a=0
End If
b = VBA.Right(a, 4)
C = VBA.Left(a, 6)
Sheets("光板").Range("H1") = C & Format(b + 1, "0000") ‘生成编号
ActiveWorkbook.Save
End Sub '结束程序
这是我的宏，请帮忙在生成编号后，把工作簿另存到指定的目录，（加个判断，如果未发现该目录文件夹，那就创建一个文件夹，比如D:/华天加工单/）并根据编号重命名文件名称为"XX"(XX可任意修改)&"指定单元格后4位"(也就是上面H1单元格的编号的后4位数值)&.xls,再加个判断,如果文件名重复,那就在文件名后面加上-1, -2, -3 (比如20150001-1,20150002-2,以此类推),我没学过VBA,所以只能讲清楚大概的意思,代码写不出来- -帮忙下,谢谢!

Answer 1

Application.DisplayAlerts = False '禁止弹出保存替换提示消息
'5 excel文件保存和备份
Sub w5()
Dim wb As Workbook
Set wb = ThisWorkbook
wb.Save
wb.SaveCopyAs "D:/ABC.xls"
End Sub
On Error Resume Next '错误继续
MkDir "D:\" & "备份" '建文件夹 ThisWorkbook.Path
不管存不存在都建一下。

追问

你好,在吗?我私信你请教你下

追答

在啊，可以。