EXCEL VBA 多sheet批量转转PDF
python
Sub zhuanpdf()
'转pdf
Application.ScreenUpdating = False '关闭刷新
Dim chaifm As String '拆分名
chaifm = Sheets("参数表").Cells(75, 2).Value
Dim yuanbm As String '原表名
Dim ws As Worksheet '定义表格
Dim biao As String '表名
Dim biao2 As String '辅助记数，有与否
yuanbm = ActiveSheet.Name
biao = ""
biao2 = ""
On Error Resume Next
Set ws = Nothing
'第一个表
If Sheets("参数表").Cells(5, 2).Value = True And Sheets("参数表").Cells(8, 2).Value <> "" Then
biao = Sheets("参数表").Cells(8, 2).Value
Set ws = Sheets(biao)
If ws Is Nothing Then '指定的工作表不存在
Else '指定的工作表已存在
Sheets(biao).Activate
biao2 = biao
Set ws = Nothing
End If
End If
'第二个表
If Sheets("参数表").Cells(6, 2).Value = True And Sheets("参数表").Cells(9, 2).Value <> "" Then
biao = Sheets("参数表").Cells(9, 2).Value
Set ws = Sheets(biao)
If ws Is Nothing Then '指定的工作表不存在
Else '指定的工作表已存在
If biao2 = "" Then
Sheets(biao).Activate
Else
Sheets(biao).Select Replace:=False
End If
biao2 = biao
Set ws = Nothing
End If
End If
'第三个表
If Sheets("参数表").Cells(7, 2).Value = True And Sheets("参数表").Cells(10, 2).Value <> "" Then
Dim biaochuan As String '表串，即多个工作表，用"/"分开
Dim iii As Integer
biaochuan = Sheets("参数表").Cells(10, 2).Value
iii = 1
Do While iii <> 100
iii = InStr(1, biaochuan, "/", 0)
If iii = 0 Then
iii = 100
biao = biaochuan
Else
biao = Left(biaochuan, iii - 1)
biaochuan = Mid(biaochuan, iii + 1, 300)
End If
Set ws = Sheets(biao)
If ws Is Nothing Then '指定的工作表不存在
Else '指定的工作表已存在
If biao2 = "" Then
Sheets(biao).Activate
Else
Sheets(biao).Select Replace:=False
End If
biao2 = biao
Set ws = Nothing
End If
Loop
End If
'生成pdf
Call zhuanpdf2(chaifm)
On Error GoTo 0
Sheets(yuanbm).Select
Application.ScreenUpdating = True '开启刷新
End Sub
Sub zhuanpdf2(chaifm As String)
'转pdf2
luj = ThisWorkbook.Path
If Dir(luj & "\拆分表", vbDirectory) = Empty Then
MkDir luj & "\拆分表"
End If
luj = luj & "\拆分表\"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
luj & chaifm & ".pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
False
End Sub