Excel VBA Code !

Hallo,
ich habe in einer Excel-Tabelle in der Spalte A immer die Bezeichnung "page-break-after" stehen und in der
Spalte B steht der ein Name. Ich möchte nun nach jedem "page-break-after" eine PDF erstellen was den Namen
aus der Spalte B hat. Ich hoffe jemand eine Idee für einen VBA Code.

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

Content-ID: 43876207075

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

Ausgedruckt am: 21.11.2024 um 22:11 Uhr

13 Kommentare

Neuester Kommentar

Hi.

Ungetestete ChatGPT Lösung:

Sub PDFsErstellen()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim currentName As String
    Dim pdfPath As String

    ' Setze den Pfad, in dem die PDFs gespeichert werden sollen  
    pdfPath = "C:\Dein\Pfad\Hier\"  

    ' Setze das Arbeitsblatt  
    Set ws = ThisWorkbook.Sheets("DeinBlattName")  

    ' Finde die letzte Zeile mit Daten in Spalte A  
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row  

    ' Durchlaufe die Zeilen  
    For i = 1 To lastRow
        ' Überprüfe, ob "page-break-after" in Spalte A vorhanden ist  
        If ws.Cells(i, 1).Value = "page-break-after" Then  
            ' Wenn ja, hole den Namen aus Spalte B  
            currentName = ws.Cells(i, 2).Value

            ' Erstelle PDF mit dem aktuellen Namen  
            ws.ExportAsFixedFormat Type:=xlTypePDF, Filename:=pdfPath & currentName & ".pdf", Quality:=xlQualityStandard  
        End If
    Next i
End Sub

Gruß

Zu der ExportAsFixedFormat-Methode lassen sich auch noch bestimmte Einstellungen vornehmen, die Du hier nachlesen kannst: learn.microsoft.com/de-de/office/vba/api/excel.workbook.exportasfixedformat

Hallo himem.sys,

vielen Dank für die Antwort.
Mein Problem ist er schreibt alles in eine PDF.
Ich bräuchte aber alles einzelene PDF's.
Ich habe mal einen Ausschnitt meiner Tabelle angefügt.
Man sieht auf dem Ausschnitt das Ende und den Anfang der Tabelle.
Nach jedem page-break-after brauche ich eine pdf Datei mit dem Namen aus der Süalte C.
Danke für die Hilfe.

Zitat von @jkrbrv:

Hallo himem.sys,

vielen Dank für die Antwort.
Mein Problem ist er schreibt alles in eine PDF.
Ich bräuchte aber alles einzelene PDF's.
Ich habe mal einen Ausschnitt meiner Tabelle angefügt.
Man sieht auf dem Ausschnitt das Ende und den Anfang der Tabelle.
Nach jedem page-break-after brauche ich eine pdf Datei mit dem Namen aus der Süalte C.
Danke für die Hilfe.

Du meinst sicherlich, dass er immer den kompletten Inhalt in die PDFs schreibt, oder?
Das liegt daran, dass in der Lösung ja die betreffenden Teilabschnitte nicht berücksichtigt werden, also der Inhalt nicht aufgeteilt wird.
Das könntest Du bspw. dadurch erreichen, dass Du den Druckbereich für jede PDF neu definierst (sind die Inhalte gleichlang, kannst Du den Druckbereich auch auf Seiten begrenzen, wenn das entsprechend im Druckbereich so eingestellt ist und dann mit from-Parameter arbeitest), also quasi für jeden Bereich angibst, welche Informationen die Datei beinhalten soll.

Näheres zu PageSetup.PrintArea findest Du hier: learn.microsoft.com/de-de/office/vba/api/excel.pagesetup.printarea

Hi.

Sub ExportPDFs()
    Dim lastRow As Long, last As Long, f As Range, tmp As Worksheet
    ' Ausgabeordner  
    Const OUTFOLDER = "G:\ausgabe"  
    ' temporäres sheet erstellen  
    Set tmp = Sheets.Add(after:=Sheets(Sheets.Count))
    ' Meldungen deaktivieren  
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    ' auf erstem sheet arbeiten  
    With Sheets(1)
        ' letzte belegte Zeile ermitteln  
        lastRow = .UsedRange.SpecialCells(xlCellTypeLastCell).Row
        last = lastRow
        ' Suchbereich festlegen  
        With .Range(.Cells(1, "A"), .Cells(lastRow, "A"))  
            ' Suche nach Begriff  
            Set f = .Find("page-break-after", LookIn:=xlValues, SearchDirection:=xlPrevious)  
            ' Wenn gefunden   
            If Not f Is Nothing Then
                ' Fundstelle merken  
                first = f.Address
                Do
                    ' Inhalt des temporären Sheets löschen  
                    tmp.UsedRange.Clear
                    ' Seitenausrichtung  
                    tmp.PageSetup.Orientation = xlLandscape
                    ' Inhalt einfügen  
                    .Range(.Cells(f.Row + 1, 1), .Cells(last, 1)).EntireRow.Copy
                    tmp.Range("A1").PasteSpecial xlPasteAll  
                    tmp.Range("A1").PasteSpecial xlPasteColumnWidths  
                    ' Druckbereich festlegen  
                    tmp.PageSetup.PrintArea = tmp.UsedRange.Address
                    ' Blatt exportieren  
                    tmp.ExportAsFixedFormat xlTypePDF, OUTFOLDER & "\" & f.Offset(1, 2).Value & ".pdf"  
                    last = f.Row - 1
                    ' nächste Fundstelle finden  
                    Set f = .FindPrevious(f)
                Loop While Not f Is Nothing And f.Address <> first
            End If
        End With
    End With
    ' temporäres Sheet löschen  
    tmp.Delete
    ' Meldungen aktivieren  
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

Gruß Katrin

Zitat von @8030021182:

Hi.

Sub ExportPDFs()
    Dim lastRow As Long, last As Long, f As Range, tmp As Worksheet
    ' Ausgabeordner  
    Const OUTFOLDER = "G:\ausgabe"  
    ' temporäres sheet erstellen  
    Set tmp = Sheets.Add(after:=Sheets(Sheets.Count))
    Application.DisplayAlerts = False
    ' auf erstem sheet arbeiten  
    With Sheets(1)
        ' letzte belegte Zeile ermitteln  
        lastRow = .UsedRange.SpecialCells(xlCellTypeLastCell).Row
        last = lastRow
        ' Suchbereich festlegen  
        With .Range(.Cells(1, "A"), .Cells(lastRow, "A"))  
            ' Suche nach Begriff  
            Set f = .Find("page-break-after", LookIn:=xlValues, SearchDirection:=xlPrevious)  
            ' Wenn gefunden   
            If Not f Is Nothing Then
                ' Fundstelle merken  
                first = f.Address
                Do
                    ' Inhalt des temporären Sheets löschen  
                    tmp.UsedRange.Clear
                    ' Inhalt einfügen  
                    .Range(.Cells(f.Row + 1, 1), .Cells(last, 1)).EntireRow.Copy
                    tmp.Range("A1").PasteSpecial xlPasteAll  
                    tmp.Range("A1").PasteSpecial xlPasteColumnWidths  
                    ' Blatt exportieren  
                    tmp.ExportAsFixedFormat xlTypePDF, OUTFOLDER & "\" & f.Offset(1, 2).Value & ".pdf"  
                    last = f.Row - 1
                    ' nächste Fundstelle finden  
                    Set f = .FindPrevious(f)
                Loop While Not f Is Nothing And f.Address <> first
            End If
        End With
    End With
    tmp.Delete
    Application.DisplayAlerts = True
End Sub

Gruß Katrin

Auch eine gute Lösung 😎

Nach jedem page-break-after brauche ich eine pdf Datei mit dem Namen aus der Süalte C.

Und im Ursprungsbeitrag stand Spalte B nicht eine Zeile drunter und in Spalte C ... So viel zu einer verlässlichen Beschreibung des Weihnachtsmanns 😇. Ich gehe dann mal weiter meine Hasch-Plätzchen backen 😜.

Zitat von @8030021182:
Ich gehe dann mal weiter meine Hasch-Plätzchen backen 😜.

Aber nicht allein essen 😁

Hallo,
vielen Dank für den Code.
Eine kleine Frage noch, der Export für jedes PDF sollte im Querformat und alle Spalten
auf einem Blatt sein.

der Export für jedes PDF sollte im Querformat und alle Spalten
auf einem Blatt sein.

Das ist eine Anforderung und ich finde, die könntest Du dir selbst erarbeiten. Einige Infos dazu gibts hier bereits.

Gruß

Zitat von @jkrbrv:

Hallo,
vielen Dank für den Code.
Eine kleine Frage noch, der Export für jedes PDF sollte im Querformat und alle Spalten
auf einem Blatt sein.

Bitteschön:
PageSetup.Orientation-Eigenschaft (Excel)
VPageBreaks.Add-Methode (Excel) bzw. PageSetup.PrintArea-Eigenschaft (Excel)

Danke. Ich konnte das Problem lösen.

Schön, dass Du die Menschen hier dran teilhaben lässt, so wie wir Dich an unserem Wissen haben teilnehmen lassen - nicht. Wieso postest Du deinen finalen Code nun nicht, dass evtl. noch andere Suchende in Spe was davon haben könnten?