AW: Arbeitsmappen per Kriterium selektieren und PDF
26.03.2015 10:21:56
Klexy
Ich hatte mal was ähnliches gemacht, an dem du dich orientieren kannst. Du musst noch ein IF einbauen, das A1 nach deinem Signal abfragt.
Ich hoffe, das hilft dir weiter.
Sub ky_PDF_erzeugen()
' --- Info --------------------------------------------------------------------------------
' Dieses Makro selektiert alle Tabellenblätter ab dem Blatt 'Cover' und druckt sie als PDF.
' Das verwendete PDF-Programm muss in die Variable "PDFDrucker" eingetragen werden.
sheet_home = "Input"
Dim PDFDrucker As String ' Variable für den PDF-Drucker
PDFDrucker = "PDF-XChange 4.0 auf Ne01:"
Dim Standarddrucker As Variant ' der auf dem jeweiligen Platz eingestellte Standarddrucker
Dim i As Integer ' Zähler der Tabellenblätter
i = 2 ' beginnt ab dem zweiten Tabellenblatt, weil das erste nur der Steuerung dient
Dim LosGehts As Integer ' Schalter wenn das erste zu druckende Blatt erreicht ist
LosGehts = 0
Dim letztes As Integer ' letztes Blatt der Arbeitsmappe
letztes = ActiveWorkbook.Worksheets.Count
Dim Signal As String ' Name des ersten zu druckenden Blattes
Signal = "Cover"
Dim BlätterAnzahl As Long
BlätterAnzahl = -1
Dim BlätterNamen() As String
Dim Drugger As String ' Name des gefundenen gültigen PDF-Druckers
Sheets(sheet_home).Select
Sheets(sheet_home).Range("A1").Select
' Array der zu markierenden Blätter bilden:
Do Until Sheets(i - 1).Name = Sheets(letztes).Name
If LosGehts = 1 Then
BlätterAnzahl = BlätterAnzahl + 1
ReDim Preserve BlätterNamen(BlätterAnzahl)
BlätterNamen(BlätterAnzahl) = Sheets(i).Name
End If
If LosGehts 1 Then
If Sheets(i + 1).Name = Signal Then
LosGehts = 1
Else
End If
Else
End If
i = i + 1
Loop
Sheets(BlätterNamen()).Select
Standarddrucker = ActivePrinter
On Error Resume Next
ActivePrinter = PDFDrucker
Drugger = ActivePrinter
If InStr(Drugger, "PDF") > 0 Then
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
Sheets(sheet_home).Select
Else
MsgBox " _
_________________________________________________________________________________________" & Chr(10) & _
"" & Chr(10) & _
" Es ist kein bekannter PDF-Drucker lokal installiert." & Chr(10) & _
"" & Chr(10) & _
" _
_________________________________________________________________________________________"
End If
ActivePrinter = Standarddrucker
End Sub