Excel Dateien als PDF drucken - kleine Probleme in der Umsetzung mehrerer Tabellenblätter

Hallo zusammen,

ich versuch mich mal kurz zu fassen:

Aufgabe:
Einen Ordner mit Excel-Dateien als PDFs ausdrucken.
Jedes Excel-Dokument enthält mehrere Tabellenblätter (Page 1, Page 2, ..., Data, Adresses, sonstwas...) Die Anzahl der "Page x" Blätter ist inhaltabhäng.
Es sollen nur die Tabellenblätter "Page x" gedruckt werden - alle in ein PDF pro Excel-Dokument.

Lösungsansatz:
Verwendete Excel-Version: Excel 2003, .xls-Dateien
PDF-Drucker: FreePDF
Makro in einer Datei, wie folgt:

Pseudo-Sprache:
Öffne xls-Datei aus Verzeichnis,
Markiere alle Tabellenblätt, wenn in Bezeichnung an Stelle 6 eine Zahl vorkommt (z.b. Page 1)
Drucke Selektion an PDF Drucker (fest eingestellter Ausgabepfad)
Nächste Datei...

Sub Ordner_bearbeiten_RE()

Dim StrVerzeichnis As String
Dim StrTyp As String
Dim Dateiname As String

Dim wb As Workbook
Dim wksX As Worksheet

StrVerzeichnis = "C:\daten\IT8\xls\Re\"
StrTyp = "*.xls"
Dateiname = Dir(StrVerzeichnis & StrTyp)
Do While Dateiname <> ""
        
        ' Variablen für Array initialisieren
        Dim varArr() As Variant
        ReDim varArr(0)

        Set wb = Workbooks.Open(StrVerzeichnis & Dateiname)
        For Each wksX In wb.Worksheets
    
            If IsNumeric(Mid(wksX.Name, 6, 1)) Then            'Verwende Tabellenblatt, wenn an Position 6 eine Zahl steht ("page X")
                varArr(UBound(varArr)) = wksX.Name
                ReDim Preserve varArr(UBound(varArr) + 1)
            End If
        
        Next wksX
        
        ReDim Preserve varArr(UBound(varArr) - 1)       ' Array durchgehen und alle Tabellenblätter markieren
        Sheets(varArr).Select
        ' Selektierte Tabellenblätter drucken
        ActiveWindow.SelectedSheets.PrintOut Copies:=1, ActivePrinter:= _
            "FreePDF XP - IT8-RE", Collate:=True
        
        wb.Close False

    Dateiname = Dir
Loop
End Sub

Problem:
Wenn Dokument nur Page 1 und keine weiteren "Page x" enthält läuft alles prima.
Wenn mehrere Seiten "Page x" vorhanden sind, bekomme ich irgendwie 2 Drucke, einmal Seite 1 und einmal die restlichen Seiten.
Da der PDF-Drucker in dem Fall das Dokument mit Seite 1 überschreibt (gleicher Name) bleibt ein Dokument übrig, wo Seite 1 fehlt.

Ich finde den Fehler leider nicht. Hat jemand eine Idee?
Vielleicht hat auch jemand eine bessere Idee?

Freue mich über Eure Hinweise
LG Daniel

Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben

Content-ID: 249441

Url: https://administrator.de/contentid/249441

Ausgedruckt am: 26.11.2024 um 07:11 Uhr

4 Kommentare

Neuester Kommentar

Hallo,

Zitat von @DeeJayBee:
Vielleicht hat auch jemand eine bessere Idee?

Klappt es mit deiner Version von FreePDF denn manuell?
Andere Version von FreePDF?
Anderer PDF Generator z.B. PDFCreator kanns?
Adobe Acrobat kanns?

Gruß,
Peter

Hallo Peter,

es nicht das Problem des PDF-Druckers,
Ich sehe, dass Excel 2 Druckjobs abschickt.
Einmal "Seite 1" und einmal "Seite 2 - Rest"

Wenn Excel den Druckjob "Seite 1 - Rest" drucken würde, wäre das Problem passé.
Es bringt mir leider auch nichts, wenn ein PDF Drucker 2 Dokumente abspeichern würde, es muss in einem sein.

Gruß
Daniel

Hallo,

Zitat von @DeeJayBee:
Einmal "Seite 1" und einmal "Seite 2 - Rest"

Du nutzt VBA. Dann nutze den Einzelschritt um zu sehen wann was passiert und dir die Ergebnisse druckt. Dann siehst du wann Seite 1 gedruckt wird und wann Seite2 - x gedruckt wird. Sich die Werte auch ausgeben lassen kann helfen (debug.print). Auch sich die Arrays und deren Inhalt sowie Zähler ansehen wird dir helfen. F8 ist dein Freund im VBA

Gruß,
Peter

Hallo DeeJayBee!

Versuchs mal damit:

Option Explicit
Option Compare Text

Private Const strTyp = "*.xls"  
Private Const strVerzeichnis = "C:\daten\IT8\xls\Re\"  

Private Const strName = "Page #*"  
Private Const strPrinter = "FreePDF XP - IT8-RE"  

Sub Ordner_bearbeiten_RE()
    Dim objSheet As Worksheet, objSheetList As Object, strDateiname As String
    
    Set objSheetList = CreateObject("Scripting.Dictionary")  
    
    strDateiname = Dir(strVerzeichnis & strTyp)
    
    Do While strDateiname <> ""  
        With Workbooks.Open(strVerzeichnis & strDateiname)
            For Each objSheet In .Worksheets
                If objSheet.Name Like strName Then
                    objSheetList.Add objSheetList.Count, objSheet.Name
                End If
            Next
        
            If objSheetList.Count Then
                .Sheets(objSheetList.Items).PrintOut Copies:=1, ActivePrinter:=strPrinter
            End If
                 
           .Close False
        End With
        
        objSheetList.RemoveAll:   strDateiname = Dir
    Loop
End Sub