打开另存为对话框并在取消时退出

Question

我正在创建一个自动的购买请求，其中用户可以提出购买请求，当他单击一个按钮时，将弹出一个另存为对话框，允许用户将文件保存在所需的位置，然后增加RTP编号并关闭excel工作表。下面是我的代码：

Sub sbUnProtectSheet()
Worksheets("RTP").Unprotect "123"
End Sub
Sub sbProtectSheet()
Worksheets("RTP").Protect "123", True, True
End Sub

Sub PostToRegister()
Dim WS1 As Worksheet
Dim WS2 As Worksheet
Set WS1 = Worksheets("RTP")
Set WS2 = Worksheets("Register")
nextrow = WS2.Cells(Rows.Count, 1).End(xlUp).Row + 1
WS2.Cells(nextrow, 1).Resize(1, 7).Value = Array(WS1.Range("P8"), WS1.Range("P7"), WS1.Range("P10"), WS1.Range("P11"), WS1.Range("L9"), WS1.Range("TOT"), WS1.Range("P9"))
End Sub
Sub nextRTP()
Call sbUnProtectSheet
Sheets("RTP").Range("P7").Value = Sheets("RTP").Range("P7").Value + 1
Range("B15:O26").ClearContents
Sheets("RTP").Range("E8:I8").ClearContents
Sheets("RTP").Range("P9:P10").ClearContents
Sheets("RTP").Range("L7:L9").ClearContents
Sheets("RTP").Range("C32:I35").ClearContents
Sheets("RTP").Range("B38:P40").ClearContents
Sheets("RTP").CheckBoxes.Value = False
Call sbProtectSheet
End Sub

Sub SaveRTPWithNewName()
 Dim USERRESPONSE As Boolean
    USERRESPONSE = Application.Dialogs(xlDialogSaveAs).Show(PDFfileName, 52)
If WorksheetFunction.CountA(Sheets("RTP").Cells(8, "E"), Sheets("RTP").Cells(7, "L"), Sheets("RTP").Cells(8, "L"), Sheets("RTP").Cells(9, "L"), Sheets("RTP").Cells(9, "P"), Sheets("RTP").Cells(10, "P"), Sheets("RTP").Cells(38, "B")) = "7" Then

If WorksheetFunction.CountA(Sheets("RTP").Cells(15, "B"), Sheets("RTP").Cells(15, "C"), Sheets("RTP").Cells(15, "E"), Sheets("RTP").Cells(15, "M"), Sheets("RTP").Cells(15, "N"), Sheets("RTP").Cells(15, "O")) = "6" Then

Call sbUnProtectSheet
'PostToRegister
Call Save_Workbook_As_PDF
If USERRESPONSE = False Then
MsgBox ("you clicked no!")
Exit Sub
End If

nextRTP
Call sbProtectSheet
ActiveWorkbook.Save
ActiveWorkbook.Close
Else: MsgBox "NO ITEM INPUT RECEIVED. ENTER ALEAST ONE ITEM TO RAISE RTP"
End If
Else: MsgBox "ENTER ALL DETAILS TO RAISE RTP"
End If
End Sub

Public Sub Save_Workbook_As_PDF()

    Dim i As Integer, PDFindex As Integer
    Dim PDFfileName As String
   
       
    With ActiveWorkbook
        PDFfileName = "RTP " & Range("P7").Value & ".pdf"
    End With
    
    With Application.FileDialog(msoFileDialogSaveAs)
  
   
    PDFindex = 0
      For i = 1 To .Filters.Count
        If InStr(VBA.UCase(.Filters(i).Description), "PDF") > 0 Then PDFindex = i
       Next

        .Title = "Save workbook as "
        .InitialFileName = PDFfileName
        .FilterIndex = PDFindex
                If .Show Then
         
           Worksheets("RTP").ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFfileName, _
                Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
               
                End If
        
                       
    End With
    
End Sub

问题是，即使用户单击cancel，代码也会继续运行，并将rtp #递增2，我希望代码在用户单击cancel...any提示时退出。

Answer 1

这是您的简化代码，这应该是有效的答案。但是您的代码可能有其他错误(您正在使用activeworkbook等)。但是尝试这个简单的例子，它应该向你展示当你选择或不选择某些东西时它是如何工作的。

Sub SaveRTPWithNewName_simple()
 

If Save_Workbook_As_PDF = False Then
    MsgBox "you clicked no!"
    Exit Sub
Else
    MsgBox "You selected something"
End If

MsgBox "Next procedure nextRTP"
MsgBox "Next procedure sbProtectSheet"

End Sub

Public Function Save_Workbook_As_PDF() As Boolean

Dim PDFindex As Integer
Dim PDFfileName As String

With Application.FileDialog(msoFileDialogSaveAs)

    PDFindex = 0
    PDFfileName = "dummy name"
    
    .Title = "Save workbook as "
    .InitialFileName = PDFfileName
    .FilterIndex = PDFindex
            
    If .Show <> 0 Then
        Save_Workbook_As_PDF = True
        'export file
    Else
        Save_Workbook_As_PDF = False
    End If
    
                   
End With
End Function

Answer 2

这可以帮助你..。如果.Show，则专注于您拥有的部分

With Application.FileDialog(msoFileDialogSaveAs)
    If .Show <> 0 Then
        'continue
    Else
        'enable events and screen updating
        Exit Sub
        'or you can use End instead of Exit Sub (depends on how you are nesting your procedures)
    End If
End With

编辑：

在发布了我的答案后，我注意到你在你的"SaveRTPWithNewName“中请求某种类型的用户响应。因此，我将Save_Workbook_As_PDF转换为Function而不是Sub，该函数返回boolean = true或false。请参阅2个修改后的程序。

Sub SaveRTPWithNewName()
 Dim USERRESPONSE As Boolean
    USERRESPONSE = Application.Dialogs(xlDialogSaveAs).Show(PDFfileName, 52)
If WorksheetFunction.CountA(Sheets("RTP").Cells(8, "E"),     Sheets("RTP").Cells(7, "L"), Sheets("RTP").Cells(8, "L"), Sheets("RTP").Cells(9, "L"), Sheets("RTP").Cells(9, "P"), Sheets("RTP").Cells(10, "P"),     Sheets("RTP").Cells(38, "B")) = "7" Then

If WorksheetFunction.CountA(Sheets("RTP").Cells(15, "B"), Sheets("RTP").Cells(15, "C"), Sheets("RTP").Cells(15, "E"), Sheets("RTP").Cells(15, "M"), Sheets("RTP").Cells(15, "N"), Sheets("RTP").Cells(15, "O")) = "6" Then

Call sbUnProtectSheet
'PostToRegister

If Save_Workbook_As_PDF = False Then
MsgBox ("you clicked no!")
Exit Sub
End If

nextRTP
Call sbProtectSheet
ActiveWorkbook.Save
ActiveWorkbook.Close
Else: MsgBox "NO ITEM INPUT RECEIVED. ENTER ALEAST ONE ITEM TO RAISE RTP"
End If
Else: MsgBox "ENTER ALL DETAILS TO RAISE RTP"
End If
End Sub

Public Function Save_Workbook_As_PDF() As Boolean

Dim i As Integer, PDFindex As Integer
Dim PDFfileName As String

   
With ActiveWorkbook
    PDFfileName = "RTP " & Range("P7").Value & ".pdf"
End With

With Application.FileDialog(msoFileDialogSaveAs)


PDFindex = 0
  For i = 1 To .Filters.Count
    If InStr(VBA.UCase(.Filters(i).Description), "PDF") > 0 Then PDFindex = i
   Next

    .Title = "Save workbook as "
    .InitialFileName = PDFfileName
    .FilterIndex = PDFindex
            
            If .Show <> 0 Then
                Save_Workbook_As_PDF = True
     
       Worksheets("RTP").ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFfileName, _
            Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
            Else
                Save_Workbook_As_PDF = False
            End If
    
                   
End With

End Function

当您需要从procedure中检索1个结果时，使用函数代替Subs是很好的。当你需要更多的结果时，你应该使用过程头中定义的参数和ByRef...

希望这能有所帮助