VBA-Excel-重置var宏

问题描述 投票:0回答:1

我希望你一切都好。我编写了一个宏,用于保存活动工作簿以及日期和小时。重新运行代码后,除了小时,日期没有重置之外,其他所有东西都正常运行。

这里是代码:

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”,而不是当前时间和日期值。

感谢您的帮助纳克索斯

excel vba
1个回答
0
投票

最后根据您的建议,我简化了代码,现在一切正常。我将其发布给下一个用户

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
© www.soinside.com 2019 - 2024. All rights reserved.