Hallo,

Vielleicht ist jemand in der Lage zu helfen

Ich habe ein MAkro zum Speichern von mehreren Word-Seiten als einzelene PDF Dateine mit den Namen aus dem TExt (erster Absatz)

Allerdings speichert mit alle Dateitn unter selben Namen

Was muss man dorn anpassen?

Sub SaveAsSeparatePDFs()
'UpdatebyExtendoffice20181120
    Dim I As Long
    Dim xDlg As FileDialog

    Dim xFolder As Variant
    Dim xStart, xEnd As Integer
    Dim dateiname As String
    
    On Error GoTo lbl
    
    Set xDlg = Application.FileDialog(msoFileDialogFolderPicker)
    If xDlg.Show <> -1 Then Exit Sub
    xFolder = xDlg.SelectedItems(1)
    xStart = CInt(InputBox("Start Page", "KuTools for Word"))
    xEnd = CInt(InputBox("End Page:", "KuTools for Word"))
    If xStart <= xEnd Then
        For I = xStart To xEnd
    
            With ActiveDocument
            dateiname = .Range(Start:=.Paragraphs(1).Range.Start, End:=.Paragraphs(1).Range.End - 1).Text & "_"
                Application.Browser.Target = wdBrowsePage
    Application.Browser.Next
            End With
            
            ActiveDocument.ExportAsFixedFormat OutputFileName:= _
                dateiname & I & ".pdf", ExportFormat:=wdExportFormatPDF, _
                OpenAfterExport:=False, OptimizeFor:=wdExportOptimizeForPrint, Range:= _
                wdExportFromTo, From:=I, To:=I, Item:=wdExportDocumentContent, _
                IncludeDocProps:=False, KeepIRM:=False, CreateBookmarks:= _
                wdExportCreateHeadingBookmarks, DocStructureTags:=True, _
                BitmapMissingFonts:=False, UseISO19005_1:=False
        Next
    End If
    Exit Sub
lbl:
    MsgBox "Enter right page number", vbInformation, "KuTools for Word"
End Sub