我正在尝试创建一个宏,在保存时会询问用户他们正在使用的文件是否为最终版本。如果是,我想将该文件的副本保存在不同的目的地。它还会创建一个指示器,其中包含最终副本的用户名和日期,这样,如果用户尝试创建另一个最终副本,它会询问他们是否要覆盖[日期]上[用户名]创建的版本。
我决定使用AfterSave而不是BeforeSave,因为我希望用户可以选择在宏运行之前选择Save和SaveAs。
我遇到的问题是,如果用户表明它是最终版本,则会保存副本,从而触发AfterSave事件。是否有一行代码可以添加,以便在保存文件副本后停止AfterSave事件?
这是我目前的代码。
Private Sub Workbook_AfterSave(ByVal Success As Boolean)
If Success Then
Call YesNoMessageBox
End If
End Sub
'Saves copy of tool if final version
Sub YesNoMessageBox()
Dim Answer1 As String
Dim MyNote1 As String
Dim fileName As String
Dim dlgOpen As FileDialog
Dim MyYear
Dim FilePath
Dim Answer2 As String
Dim MyNote2 As String
MyNote1 = "Is this the FINAL version?"
'Display MessageBox
Answer1 = MsgBox(MyNote1, vbQuestion + vbYesNo, "???")
If Answer1 = vbYes Then
If Not Worksheets("Data Input").Range("M2") = vbNullString Then
MyNote2 = "There is already a version saved by " & Worksheets("Data Input").Range("M2") & " on " & Worksheets("Data Input").Range("M3") & "." & vbNewLine & "Would you like to overwrite it?"
Answer2 = MsgBox(MyNote2, vbQuestion + vbYesNo, "???")
If Answer2 = vbYes Then
strUName = CreateObject("WScript.Network").UserName
Worksheets("Data Input").Range("M2") = strUName
Worksheets("Data Input").Range("M3") = Date
'Saves copy of tool in [folder name] folder
MyYear = Year(Worksheets("Data Input").Range("D13"))
ThisWorkbook.SaveAs fileName:="G:\[file path]" & Worksheets("Data Input").Range("D9") & " - " & Worksheets("Data Input").Range("D7") & " " & MyYear & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled
MsgBox "Copy of tool saved in" & Application.ThisWorkbook.Path
End If
Else
strUName = CreateObject("WScript.Network").UserName
Worksheets("Data Input").Range("M2") = strUName
Worksheets("Data Input").Range("M3") = Date
'Saves copy of tool in [folder name]folder
MyYear = Year(Worksheets("Data Input").Range("D13"))
ThisWorkbook.SaveAs fileName:="G:\[File Path]\" & Worksheets("Data Input").Range("D9") & " - " & Worksheets("Data Input").Range("D7") & " " & MyYear & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled
MsgBox "Copy of tool saved in" & Application.ThisWorkbook.Path
End If
End If
End Sub
答案 0 :(得分:0)
在SaveAs
之前停用活动,但不要忘记在以下后再次启用:
Application.EnableEvents = False
ThisWorkbook.SaveAs fileName:="G:\[File Path]\" & Worksheets("Data Input").Range("D9") & " - " & Worksheets("Data Input").Range("D7") & " " & MyYear & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled
Application.EnableEvents = True