Question

我已经设置了一个命令按钮，将当前工作表保存为PDF文件。我已经玩了几个小时的代码，几乎让它正常工作，但似乎我已经断开了一些区域，找不到回来的路。请参阅下面的我正在使用的代码以及此时遇到问题的变量。任何帮助或信息将不胜感激！提前谢谢！

的问题：

在保存应用程序框中单击“取消”时，文档仍会尝试保存。

如果文件已存在：

选择“是”进行覆盖不会保存文档。

选择“否”进行覆盖并重命名为另一个已存在的文档不会提示另一个问题框是否覆盖。它只是覆盖了原始文档名称。

Sub PDFFHA()
Dim wsA As Worksheet
Dim wbA As Workbook
Dim strName As String
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim myFile As Variant
On Error GoTo errHandler

Set wbA = ActiveWorkbook
Set wsA = ActiveSheet

strPath = "I:\OCC FRB REMIC Reporting\Quality Control\PDFs"
If strPath = "" Then
  strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"

strName = Replace(wsA.Range("D3"), " ", "")
strName = Replace(strName, ".", "_")

strFile = "FHA" & "_" & strName & "_" & "QC" & ".pdf"
strPathFile = strPath & strFile

myFile = Application.GetSaveAsFilename _
    (InitialFileName:=strPathFile, _
        FileFilter:="PDF Files (*.pdf), *.pdf", _
        Title:="Select Folder and FileName to save")

If bFileExists(strPathFile) Then
    lOver = MsgBox("Overwrite existing file?", _
      vbQuestion + vbYesNo, "File Exists")
    If lOver <> vbYes Then
      myFile = Application.GetSaveAsFilename _
          (InitialFileName:=strPathFile, _
              FileFilter:="PDF Files (*.pdf), *.pdf", _
              Title:="Select Folder and FileName to save")
      If myFile <> "False" Then
        wsA.ExportAsFixedFormat _
            Type:=xlTypePDF, _
            Filename:=strPathFile, _
            Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, _
            OpenAfterPublish:=False
        MsgBox "PDF file has been created: " _
            & vbCrLf _
            & strPathFile

      Else
        GoTo exitHandler
      End If
    End If
Else
    wsA.ExportAsFixedFormat _
        Type:=xlTypePDF, _
        Filename:=strPathFile, _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=False
    MsgBox "PDF file has been created: " _
      & vbCrLf _
      & strPathFile
End If

exitHandler:
    Exit Sub
errHandler:
    MsgBox "Could not create PDF file"
    Resume exitHandler
End Sub
'=============================
Function bFileExists(rsFullPath As String) As Boolean
  bFileExists = CBool(Len(Dir$(rsFullPath)) > 0)
End Function
'=============================

Answer 1

首先，打开Option Explicit。

遵循If lOver <> vbYes Then中的逻辑。通过适当的缩进，您将看到它只处理<> vbYes路径并且没有Else。

所以，你实际上没有处理＆＃34;是＆＃34;情况下。
你的＆＃34;否＆＃34;逻辑只会打开一个文件对话框，我们不知道你做了什么来测试它（取消，输入新名称，只接受提供的名称？）。但是，这条逻辑路径上没有其他问题。如果你没有击中＆＃34;取消＆＃34;到文件对话框，它只会保存文件。

Answer 2

进行一些清理和重新格式化。

如果文件已存在，系统会提示您是否覆盖。代码仅检查响应为vbNo，因为vbYes表示strPathFile保持不变，即不需要采取任何措施。循环处理取消点击，以及新strPathFile再次成为现有文件的可能性。

Option Explicit

Sub PDF_FHA()

Dim wsA As Worksheet: Set wsA = ActiveWorkbook.ActiveSheet
Dim strName, strPath, strFile, strPathFile As String

On Error GoTo errHandler

' Get path
strPath = "I:\OCC FRB REMIC Reporting\Quality Control\PDFs\"

' Get and clean filename
strName = Replace(wsA.Range("D3"), " ", "")
strName = Replace(strName, ".", "_")
strFile = "FHA_" & strName & "_QC.pdf"
strPathFile = strPath & strFile

' Check if file exists, prompt overwrite
If bFileExists(strPathFile) Then
    If MsgBox("Overwrite existing file?", _
      vbQuestion + vbYesNo, "File Exists") = vbNo Then

        Do
        strPathFile = Application.GetSaveAsFilename _
          (InitialFileName:=strPathFile, _
              FileFilter:="PDF Files (*.pdf), *.pdf", _
              Title:="Select Folder and FileName to save")

        ' Handle cancel
        If strPathFile = "False" Then Exit Sub

        ' Loop if new filename still exists
        Loop While bFileExists(strPathFile)

    End If
End If

wsA.ExportAsFixedFormat _
            Type:=xlTypePDF, _
            Filename:=strPathFile, _
            Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, _
            OpenAfterPublish:=False

MsgBox "PDF file has been created: " _
            & vbCrLf _
            & strPathFile

Exit Sub

errHandler:
    MsgBox "Could not create PDF file"

End Sub

'=============================
Function bFileExists(rsFullPath As String) As Boolean
  bFileExists = CBool(Len(Dir$(rsFullPath)) > 0)
End Function
'=============================

用于保存PDF的VBA代码无法正常工作

2 个答案: