我使用以下代码生成电子表格的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
答案 0 :(得分:0)
我刚刚发现自己需要解决与此处相同的问题,现在有了更多的经验,我能够自己解决问题。我想我也应该发布我的操作方法,以防万一有人需要它。
我在网上找到了以下功能来搜索目录:
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