01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45 |
|
Option Explicit
Sub PDFExport()
Dim sSheets As String, sFileName As String
Dim bCheck As Boolean
Dim Rout, Dat
Rout = "T:\Qualitätsmanagement\Aufzeichnungen\Änderungen_Sondergenehmigungen\Requests\"
Dat = Range("M1").Value & "_" & Range("M2").Value & "_" & Range("M3").Value
' ÄA_Nummer Art.nr Art.bezeichnung
sFileName = Rout & Dat & ".pdf" _
' Vorher: FileName = Rout & Dat
sSheets = "Header info,Change description,Task list"
If Tabelle5.CheckBox36.Value Then bCheck = True: sSheets = sSheets & ",TT- Annex"
If Tabelle2.CheckBox1.Value Then bCheck = True: sSheets = sSheets & ",Annex Change description"
If Tabelle2.CheckBox1.Value Then bCheck = False: sSheets = sSheets ' doppelt und überflüssig
If Tabelle5.CheckBox36.Value Then bCheck = False: sSheets = sSheets ' doppelt und überflüssig
Sheets(Split(sSheets, ",")).Select
' PDF_DA
If Dir$(sFileName) <> "" Then
If MsgBox("Die Datei '" & sFileName & "' ist schon vorhanden!" & vbLf & vbLf _
& "Überschreiben?", vbYesNo Or vbQuestion, "PDF erzeugen") = vbNo Then Exit Sub
End If
If bCheck Then
ActiveWorkbook.ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=sFileName, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=True
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets("Header info").Select
On Error GoTo 0
End If
End Sub
|