我希望你一切都好。我编写了一个宏,用于保存活动工作簿以及日期和小时。重新运行代码后,除了小时,日期没有重置之外,其他所有东西都正常运行。
这里是代码:
Sub SaveFile()
Dim fname As String
Dim fdate As String
Dim fhour As String
Dim name As String
Dim name2 As String
Dim path As String
Dim f_name As String
Dim f_date As String
Dim f_hour As String
Dim n_ame As String
Dim n_ame2 As String
Dim p_ath As String
On Error GoTo First
fdate = Format(Date, "yyyy") & " " & Format(Date, "mm") & " " & Format(Date, "dd")
fhour = Format(Time, "hh") & "h" & Format(Time, "mm")
name = Left(ThisWorkbook.name, (InStrRev(ThisWorkbook.name, "_", -1, vbTextCompare) - 1))
path = Application.ActiveWorkbook.path
fname = name & "_" & fdate & " - " & fhour
Application.ActiveWorkbook.SaveAs Filename:=path & "\" & fname, _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
Exit Sub
First:
On Error GoTo -1
On Error GoTo Second
fdate = Format(Date, "yyyy") & " " & Format(Date, "mm") & " " & Format(Date, "dd")
fhour = Format(Time, "hh") & "h" & Format(Time, "mm")
name = Left(ThisWorkbook.name, (InStrRev(ThisWorkbook.name, "_", -1, vbTextCompare) - 1))
path = Application.ActiveWorkbook.path
fname = name & "_" & fdate & " - " & fhour
Application.ActiveWorkbook.SaveAs Filename:=path & "\" & fname, _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
Exit Sub
Second:
f_date = Format(Date, "yyyy") & " " & Format(Date, "mm") & " " & Format(Date, "dd")
f_hour = Format(Time, "hh") & "h" & Format(Time, "mm")
n_ame = Left(ThisWorkbook.name, (InStrRev(ThisWorkbook.name, ".", -1, vbTextCompare) - 1))
path = Application.ActiveWorkbook.path
f_name = n_ame & "_" & f_date & " - " & f_hour
Application.ActiveWorkbook.SaveAs Filename:=path & "\" & f_name, _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
End Sub
该宏当前第一次以所需格式保存,下一次将理解并保留正确数量的字符以正确的所需格式保存。如果输入得太早,我还设置了“第二次机会”。
当前,如果我的工作簿名为“ Workook”宏会将其保存为“ Workbook_2019 10 14-19h12”,而不是当前时间和日期值。
感谢您的帮助纳克索斯
最后根据您的建议,我简化了代码,现在一切正常。我将其发布给下一个用户
Private Sub SaveFile()
Dim fname As String
Dim fdate As String
Dim fhour As String
Dim name As String
Dim name2 As String
Dim path As String
Dim f_name As String
Dim ppfdate As String
Dim ppfhour As String
Dim ppfname As String
Dim ppfname2 As String
Dim pppath As String
dateactuelle = Now()
On Error GoTo First
fdate = Format(dateactuelle, "yyyymmdd - h\hmm")
name = Left(ActiveWorkbook.name, (InStrRev(ActiveWorkbook.name, "_", -1, vbTextCompare) - 1))
path = Application.ActiveWorkbook.path
fname = name & "_v" & fdate
Application.ActiveWorkbook.SaveAs filename:=path & "\" & fname, _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
Exit Sub
First:
ppfdate = Format(dateactuelle, "yyyymmdd - h\hmm")
ppfname = Left(ActiveWorkbook.name, (InStrRev(ActiveWorkbook.name, ".", -1, vbTextCompare) - 1))
path = Application.ActiveWorkbook.path
f_name = ppfname & "_v" & ppfdate
Application.ActiveWorkbook.SaveAs filename:=path & "\" & f_name, _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
End Sub