BeforeSaveループとブックが閉じます

Question

設定パスとファイル名を強制してブックの「コピー」を保存しようとしています。次のコードは、私が避けたいと思う2つのことを行います。まず、「メッセージ」が2回表示されます。なぜこのようなことが起こり、どうすればそれを防ぐことができますか？次に、保存アイコンをクリックしても、保存が完了した後にブックが閉じます。赤い "x"が押されていない限り、ブックを開いたままにしておく必要があります。コードは次のとおりです。

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

あなたはまた、次の

を短縮するだけで、コード

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 

をのunclutterし、3のif-then文の代わりにこれを使用することができ、コード

をクリーンアップするための提案だけのカップル

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

だけ使用

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

も& vbCrLf &と& Chr(13) & Chr(10) &を交換するか、& vbNewLine &