Question

我使用以下代码生成电子表格的PDF。

我需要添加一项功能，检查文件名是否已存在于您尝试保存的目录中，并允许更改名称。

我知道我需要创建文件路径的另一个变量，但我完全忘记了如何完成剩下的工作。

Sub PrintPDFAll()

    ThisWorkbook.Unprotect
    Worksheets("Entry").Unprotect     

    Dim MySheetName As String
    MySheetName = "Entry2"
    Sheets("Entry").Copy After:=Sheets("Entry")
    ActiveSheet.Name = MySheetName
    Range("ALL").FormatConditions.Delete
    Range("ALL").Interior.ColorIndex = 0

    'turn off screen updating
    Application.ScreenUpdating = False

    'open dialog and set file type
    Opendialog = Application.GetSaveAsFilename("", FileFilter:="PDF Files (*.pdf), *.pdf", _
                                        Title:="Quote")

    'if no value is added for file name
    If Opendialog = False Then
        MsgBox "The operation was not successful"

        Application.DisplayAlerts = False
        Sheets("Entry2").Delete
        Worksheets("Entry").Activate
        Exit Sub
    End If

    'create the pdf
    On Error Resume Next

    Sheets("Summary").Move Before:=Sheets(1)
    Sheets("Breakdown").Move Before:=Sheets(2)
    Sheets("Entry2").Move Before:=Sheets(3)
    Sheets(Array("Entry2", "Breakdown", "Summary")).Select

    With ActiveSheet.PageSetup
        .Orientation = xlPortrait
        .Zoom = False
        .FitToPagesWide = 1
        .CenterHorizontally = True
        .CenterVertically = True
        .BottomMargin = 0
        .TopMargin = 0
        .RightMargin = 0
        .LeftMargin = 0
    End With

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

    'error handler
    On Error GoTo 0

    'clear the page breaks
    ActiveSheet.DisplayPageBreaks = False

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Sheets("Entry2").Delete
    Sheets("Entry").Move Before:=Sheets(1)
    Sheets("Breakdown").Move Before:=Sheets(2)
    Sheets("Summary").Move Before:=Sheets(3)

    Worksheets("Entry").Activate
    Worksheets("Entry").Protect
    ThisWorkbook.Protect

End Sub

Answer 1

我刚刚发现自己需要解决与此处相同的问题，现在有了更多的经验，我能够自己解决问题。我想我也应该发布我的操作方法，以防万一有人需要它。

我在网上找到了以下功能来搜索目录：

Function IsFile(ByVal fName As String) As Boolean
'Returns TRUE if the provided name points to an existing file.
'Returns FALSE if not existing, or if it's a folder
    On Error Resume Next
    IsFile = ((GetAttr(fName) And vbDirectory) <> vbDirectory)
End Function

然后将以下内容修改为我的代码，以便如果找到重复的文件，它将循环播放，直到您输入一个非重复的文件名为止：

...
TryAgain:
    ...
    Opendialog = Application.GetSaveAsFilename("", filefilter:="PDF Files (*.pdf), *.pdf", _
                                        Title:="Your Doc")
    'if no value is added for file name
    If Opendialog = False Then
        MsgBox "The operation was not successful"
        Exit Sub

    End If
    If IsFile(Opendialog) = True Then
        MsgBox "File Already Exists"
    Opendialog = ""
    End If

If Opendialog = "" Then
    GoTo TryAgain
End If

保存而不覆盖当前文件

1 个答案: