Question

我正在尝试保存＆＃34;副本＆＃34;强制设置路径和文件名的工作簿。以下代码执行了两件我想避免的事情。首先，＆＃34;消息＆＃34;显示两次。为什么会发生这种情况，我该如何预防呢？其次，即使我只点击了保存图标，保存完成后工作簿也会关闭。我需要工作簿保持开放，除非红色＆＃34; x＆＃34;被压了。这是代码：

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) 

Const Function_Area = "Benefits" 

Dim Full_Filename As String 
Dim Temp_Filename_Prefix As String 
Dim Temp_Filename_Suffix As String 
Dim Temp_Path As String 
Dim Error_Check As Boolean 
Dim End_Msg As Variant 
Dim Temp_Object As Object 

Set Temp_Object = CreateObject("WScript.Shell") 

With Temp_Object 
    Temp_Path = .SpecialFolders("Desktop") & "\" 
End With 

If Range("REVIEW_TYPE").Value = "Prototype Review" Then 
    Temp_Filename_Prefix = Range("CUSTOMER_NAME").Value & Function_Area & "_PROTO_" 
End If 
If Range("REVIEW_TYPE").Value = "Final Review" Then 
    Temp_Filename_Prefix = Range("CUSTOMER_NAME").Value & Function_Area & "_FINAL_" 
End If 
If Range("REVIEW_TYPE").Value = "Compliance Review" Then 
    Temp_Filename_Prefix = Range("CUSTOMER_NAME").Value & Function_Area & "_COMPLIANCE_" 
End If 

Temp_Filename_Suffix = Format(Date, "yyyymmdd") 
Temp_Filename_Suffix = Temp_Filename_Suffix & "C" 

Full_Filename = Temp_Path & Temp_Filename_Prefix & Temp_Filename_Suffix 

End_Msg = "This file has been saved to your DESKTOP as " & Chr(13) & Chr(10) & _ 
Full_Filename 
End_Msg = MsgBox(End_Msg, vbInformation, "FILE SAVED") 

' Save file to Desktop

ActiveWorkbook.SaveAs Filename:=Full_Filename, FileFormat:=52 
ThisWorkbook.Saved = True 

End Sub

感谢您提供任何指导。

Answer 1

只是提出一些清理代码的建议

您可以使用它来代替三个if-then语句，只是为了整理代码

    Dim prfx As String

    Select Case Range("REVIEW_TYPE").Value

        Case "Prototype Review":   prfx = "_PROTO_"
        Case "Final Review":       prfx = "_FINAL_"
        Case "Compliance Review":  prfx = "_COMPLIANCE_"

        Case Else:                 ' put code here, for not any of above

    End Select

    Temp_Filename_Prefix = Range("CUSTOMER_NAME").Value & Function_Area & prfx

也缩短了以下内容

With Temp_Object 
    Temp_Path = .SpecialFolders("Desktop") & "\" 
End With

只需使用

Temp_Path = Temp_Object.SpecialFolders("Desktop") & "\"

也会将& Chr(13) & Chr(10) &替换为& vbCrLf &或& vbNewLine &

BeforeSave循环和工作簿关闭

1 个答案: