jkrbrv
Nov 13, 2023, updated at 11:24:52 (UTC)
view1194
view13
0
Goto Top

Excel VBA Code !

GermansolvedQuestionMicrosoftMicrosoft Office
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.
comment-contentCommentShareShare
Share on Facebook Share on Twitter Share on Reddit Share on Linkedin

Content-Key: 43876207075

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

Printed on: May 5, 2024 at 07:05 o'clock

13 Comments
Latest comment
Goto Top
Mitglied: 8585040390
8585040390 Nov 13, 2023 updated at 09:11:48 (UTC)
Goto Top
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ß
Member: Tomtom33
Tomtom33 Nov 13, 2023 at 10:16:37 (UTC)
Goto Top
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
Member: jkrbrv
jkrbrv Nov 13, 2023 at 10:29:37 (UTC)
Goto Top
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.
unbenannt
Member: Tomtom33
Tomtom33 Nov 13, 2023 updated at 10:49:54 (UTC)
Goto Top
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
Mitglied: 8030021182
8030021182 Nov 13, 2023 updated at 13:24:26 (UTC)
Goto Top
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
Member: Tomtom33
Solution Tomtom33 Nov 13, 2023 at 10:52:33 (UTC)
Goto Top
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 😎
Mitglied: 8030021182
8030021182 Nov 13, 2023 updated at 11:21:14 (UTC)
Goto Top
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 😜.
Member: Tomtom33
Tomtom33 Nov 13, 2023 updated at 11:26:12 (UTC)
Goto Top
Zitat von @8030021182:
Ich gehe dann mal weiter meine Hasch-Plätzchen backen 😜.

Aber nicht allein essen 😁
Member: jkrbrv
jkrbrv Nov 13, 2023 at 12:51:07 (UTC)
Goto Top
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.
Mitglied: 8585040390
8585040390 Nov 13, 2023 updated at 12:54:30 (UTC)
Goto Top
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ß
heart1
Mitglied: 8030021182
Solution 8030021182 Nov 13, 2023 updated at 13:25:06 (UTC)
Goto Top
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)
heart1
Member: jkrbrv
jkrbrv Nov 15, 2023 at 13:41:44 (UTC)
Goto Top
Danke. Ich konnte das Problem lösen.
Mitglied: 8585040390
8585040390 Nov 15, 2023 at 13:56:58 (UTC)
Goto Top
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? 
Teilen macht Spaß.

Außerdem hast Du dem falschen User die "Lösung" umgeheftet (Lösung kam von Katrin11, nicht von TomTom).

Gruß
GermansolvedQuestionMicrosoftMicrosoft Office
Hotly discussed
LinuxeroWireguard with systemd and nftablesLinuxero - 9 CommentsFrankUbuntu 24.04 LTS Noble Numbat availableFrank