Warning: file_get_contents(/data/phpspider/zhask/data//catemap/0/vba/14.json): failed to open stream: No such file or directory in /data/phpspider/zhask/libs/function.php on line 167

Warning: Invalid argument supplied for foreach() in /data/phpspider/zhask/libs/tag.function.php on line 1116

Notice: Undefined index: in /data/phpspider/zhask/libs/function.php on line 180

Warning: array_chunk() expects parameter 1 to be array, null given in /data/phpspider/zhask/libs/function.php on line 181
VBA-Excel-重置var宏_Excel_Vba - Fatal编程技术网

VBA-Excel-重置var宏

VBA-Excel-重置var宏,excel,vba,Excel,Vba,我希望你做得很好。 我编写了一个宏,用于保存带有日期和小时的活动工作簿。在我重新运行代码后,除了小时、日期之外,一切正常 代码如下: 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_h

我希望你做得很好。 我编写了一个宏,用于保存带有日期和小时的活动工作簿。在我重新运行代码后,除了小时、日期之外,一切正常

代码如下:

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” 宏将其保存为“工作簿_2019 10 14-19h12”,而不是当前的时间和日期值

谢谢你的帮助
Naxos

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

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

请查看此参考资料-尤其是在遇到错误处理程序块时,您可以做(和不能做)什么?您可以将所有日期格式缩短为一条语句:
fname=Name&Format(现在,“\u yyyy-mm-dd-hh\hmm”)
此外,您还混合使用了
ActiveWorkbook
ThisWorkbook
。不要那样做。挑一个,坚持下去。推荐的用法几乎总是
此工作簿