大约一周前,我的打印宏停止工作了。它如下所示:
Function Create_PDF(Myvar As Object, FixedFilePathName As String, _ OverwriteIfFileExist As Boolean, OpenPDFAfterPublish As Boolean) As String Dim FileFormatstr As String Dim FName As Variant
'Test If the Microsoft Add-in is installed
If Dir(Environ("commonprogramfiles") & "\Microsoft Shared\OFFICE" _
& Format(Val(Application.Version), "00") & "\EXP_PDF.DLL") <> "" Then
If FixedFilePathName = "" Then
'Open the GetSaveAsFilename dialog to enter a file name for the pdf
FileFormatstr = "PDF Files (*.pdf), *.pdf"
FName = Application.GetSaveAsFilename("", filefilter:=FileFormatstr, _
Title:="Create PDF")
'If you cancel this dialog Exit the function
If FName = False Then Exit Function
Else
FName = FixedFilePathName
End If
'If OverwriteIfFileExist = False we test if the PDF
'already exist in the folder and Exit the function if that is True
If OverwriteIfFileExist = False Then
If Dir(FName) <> "" Then Exit Function
End If
'Now the file name is correct we Publish to PDF
On Error Resume Next
Myvar.ExportAsFixedFormat _
Type:=xlTypePDF, _
FileName:=FName, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=OpenPDFAfterPublish
On Error GoTo 0
'If Publish is Ok the function will return the file name
If Dir(FName) <> "" Then Create_PDF = FName
End If
End Function
Sub SaveThisReport()
Dim MyFolder As String
Dim MyFile As String
Dim PDFname As String
Dim FileName As String
On Error Resume Next
MyFolder = CreateObject("WScript.Shell").SpecialFolders("Desktop") & Application.PathSeparator & "PDF Reports"
MkDir MyFolder
On Error GoTo 0
PDFname = ActiveSheet.Range("SelectedSchool").Value
MyFile = MyFolder & Application.PathSeparator & PDFname
FileName = Create_PDF(ActiveSheet.Range("ReportArea"), MyFile, True, False)
Range("A1").Select
包含宏的工作簿可以下载这里。
答案1
当前状态下的 VBA 代码的 SaveThisReport() 部分毫无用处,因为,
- 您尚未定义变量“精选学校”代码中的任何地方。
- 自从PDF名称和所选学校实际上做的是相同的事,所以是多余的。
- 您尚未定义变量“报告区域”代码中的任何地方。
因为对象是 ActiveSheet 所以FileName = Create_PDF(ActiveSheet.Range("ReportArea"), MyFile, True, False)
FileName = Create_PDF(ActiveSheet, MyFile, True, False)
就足够了。
尝试这个
Sub SaveThisReport()
Dim MyFolder As String
Dim MyFile As String
Dim PDFname As String
Dim FileName As String
Dim ReportArea As String
'Initialise your pdfname variable
'From your comment you've identified D2 as the file name.
PDFname = ActiveSheet.Range("D2").Value
On Error Resume Next
MyFolder = CreateObject("WScript.Shell").SpecialFolders("Desktop") & Application.PathSeparator & "PDF Reports"
MkDir MyFolder
On Error GoTo 0
MyFile = MyFolder & Application.PathSeparator & PDFname
FileName = Create_PDF(ActiveSheet, MyFile, True, False)
Range("A1").Select
End Sub
笔记:ActiveSheet 仅指当前活动的工作表!因此,如果您尝试在另一张工作表上使用它,它将引用当前工作表中的“D2”。最好确定哪张特定工作表包含您需要的信息PDFname = Sheets("YOURSHEETNAMEHERE").Range("D2").Value
。
附加说明:确保当你复制和粘贴上面的代码中,你正在更改函数名称创建_PDF引用正确的函数名称,如下所示。
Function Create_PDF(Myvar As Object, FixedFilePathName As String, _
OverwriteIfFileExist As Boolean, OpenPDFAfterPublish As Boolean) As String
Dim FileFormatstr As String
Dim FName As Variant
'Test If the Microsoft Add-in is installed
If Dir(Environ("commonprogramfiles") & "\Microsoft Shared\OFFICE" _
& Format(Val(Application.Version), "00") & "\EXP_PDF.DLL") <> "" Then
If FixedFilePathName = "" Then
'Open the GetSaveAsFilename dialog to enter a file name for the pdf
FileFormatstr = "PDF Files (*.pdf), *.pdf"
FName = Application.GetSaveAsFilename("", filefilter:=FileFormatstr, _
Title:="Create PDF")
'If you cancel this dialog Exit the function
If FName = False Then Exit Function
Else
FName = FixedFilePathName
End If
'If OverwriteIfFileExist = False we test if the PDF
'already exist in the folder and Exit the function if that is True
If OverwriteIfFileExist = False Then
If Dir(FName) <> "" Then Exit Function
End If
'Now the file name is correct we Publish to PDF
On Error Resume Next
Myvar.ExportAsFixedFormat _
Type:=xlTypePDF, _
FileName:=FName, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=OpenPDFAfterPublish
On Error GoTo 0
'If Publish is Ok the function will return the file name
If Dir(FName) <> "" Then Create_PDF = FName
End If
End Function