最近工作中需要把生成的电子表格转化成PDF格式文件,使得客户不能修改其中数据,参考有关资料,编写代码如下,调用后可实现批量转换。
Public Sub Sheet_To_PDF(ByVal strSheet As String, ByVal strFileName As String, _
ByVal bolOverwrite As Boolean, OpenPDFAfterPublish As Boolean)
Dim strFileFormat As String
Dim varFIleName As Variant
If Dir(Environ("commonprogramfiles") & "\Microsoft Shared\OFFICE" _
& Format(Val(Application.Version), "00") & "\EXP_PDF.DLL") <> "" Then
'首先检查有没安装该插件
If strFileName = "" Then
strFileFormat = "PDF Files (*.pdf), *.pdf"
varFIleName = Application.GetSaveAsFilename("", filefilter:=strFileFormat, _
Title:="请输入PDF文件名!")
strFileName = varFIleName
If varFIleName = False Then
Call Warning("ERR")
Exit Sub
End If
End If
If bolOverwrite = False Then
If Dir(strFileName) <> "" Then
Exit Sub
End If
End If
On Error Resume Next
ThisWorkbook.Sheets(strSheet).ExportAsFixedFormat _
Type:=xlTypePDF, _
FileName:=strFileName, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=True, _
OpenAfterPublish:=False
On Error GoTo 0
End If
End Sub
Public Sub Sheet_To_PDF(ByVal strSheet As String, ByVal strFileName As String, _
ByVal bolOverwrite As Boolean, OpenPDFAfterPublish As Boolean)
Dim strFileFormat As String
Dim varFIleName As Variant
If Dir(Environ("commonprogramfiles") & "\Microsoft Shared\OFFICE" _
& Format(Val(Application.Version), "00") & "\EXP_PDF.DLL") <> "" Then
'首先检查有没安装该插件
If strFileName = "" Then
strFileFormat = "PDF Files (*.pdf), *.pdf"
varFIleName = Application.GetSaveAsFilename("", filefilter:=strFileFormat, _
Title:="请输入PDF文件名!")
strFileName = varFIleName
If varFIleName = False Then
Call Warning("ERR")
Exit Sub
End If
End If
If bolOverwrite = False Then
If Dir(strFileName) <> "" Then
Exit Sub
End If
End If
On Error Resume Next
ThisWorkbook.Sheets(strSheet).ExportAsFixedFormat _
Type:=xlTypePDF, _
FileName:=strFileName, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=True, _
OpenAfterPublish:=False
On Error GoTo 0
End If
End Sub