Samenvoegen naar PDf bestanden

[Erik1965]

Octafish heeft onderstaande macro van Doug Robbins enigszins aangepast. Deze macro genereert op basis van een samenvoegbestand separate wordbestanden> Is er nu ook een mogelijkheid om ipv word bestanden PDF bestanden te genereren? Kan dat door het aanpassen van deze macro of is er een nieuwe macro voor te bouwen?






[SQL]Sub Splitter()
' splitter Macro
' Macro created by Doug Robbins to save each letter created by a mailmerge as a separate file.
Dim Letters As Integer, Counter As Integer
Dim DocName As String, sDoc as string

[SQL]sDoc = "Brief "

Letters = ActiveDocument.Sections.Count
Selection.HomeKey Unit:=wdStory
Counter = 1
While Counter < Letters
DocName = sDoc & LTrim$(Str$(Counter))
ActiveDocument.Sections.First.Range.Cut
Documents.Add
Selection.Paste
ActiveDocument.Sections(2).PageSetup.SectionStart = wdSectionContinuous
ActiveDocument.SaveAs FileName:=DocName, FileFormat:=wdFormatDocument, LockComments:=False, _
Password:="", AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, _
EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, _
SaveFormsData:=False, SaveAsAOCELetter:=False
ActiveWindow.Close
Counter = Counter + 1
Wend

End Sub[/SQL][/SQL]

 

[Domero]

ActiveDocument.SaveAs ActiveDocument.Path & "\" & Replace(filename "_","") & " " & Format(Now(), "MMDDYYYY") & ".pdf", FileFormat:=wdFormatPDF

 

[Erik1965]

ActiveDocument.SaveAs ActiveDocument.Path & "\" & Replace(filename "_","") & " " & Format(Now(), "MMDDYYYY") & ".pdf", FileFormat:=wdFormatPDF

Komt deze binnen de bestaande macro (zo ja waar?) of is dit een aparte macro die opgeroepen moet worden

 

[OctaFish]

Ik had de macro uiteraard al (in afwachting van je vraag) aangepast. Dit is 'm dan geworden.

Sub Splitter()
'------------------------------------------------------------------------------------------------------------------
' splitter Macro
' Macro created by Doug Robbins to save each letter created by a mailmerge as a separate file.
' Adapted by OctaFish to extend Filename with #th paragraph
' Split documents saved as docx and as pdf.
'------------------------------------------------------------------------------------------------------------------
Dim Letters As Integer, Counter As Integer
Dim DocName As String, sRange As String
Dim Pad As String, sNullen As String
Dim aRange As Range
Dim aDoc As Document, aDocNew As Document
Dim tmp As Variant, iPar As Integer

    DocName = "Recept "
    Pad = "H:\Temp\Word\"
    iPar = InputBox("Welk alinea(nr) bevat de documentnaam?", "Alinea selecteren", 1)
    If iPar = 0 Then iPar = 1
    If Not IsNumeric(iPar) Then iPar = 1
    Set aDoc = ActiveDocument
    Letters = aDoc.Sections.Count
    For Counter = 1 To Len(Letters)
        sNullen = sNullen & "0"
    Next Counter
    sNullen = sNullen & "0"
    
    Selection.HomeKey Unit:=wdStory
    Counter = 1
    While Counter < Letters
        '-----------------------------------------------------------------------------------------------
        'Naam samenstellen op basis van nummering
        '-----------------------------------------------------------------------------------------------
        DocName = Right(sNullen & LTrim$(Str$(Counter)), Len(Letters) + 1) & "_"
        '-----------------------------------------------------------------------------------------------
        aDoc.Sections.First.Range.Cut
        Set aDocNew = Documents.Add
        Selection.Paste
        '-----------------------------------------------------------------------------------------------
        'Naam samenstellen uit 8e alinea van tekst
        '-----------------------------------------------------------------------------------------------
        With aDocNew
            tmp = Split(aDocNew.Content, Chr(13))
            DocName = DocName & tmp(iPar - 1)
            If Right(DocName, 1) = Chr(13) Or Right(DocName, 1) = Chr(10) Then
                DocName = Left(DocName, Len(DocName) - 1)
            End If
            '-------------------------------------------------------------------------------------------
            .Sections(2).PageSetup.SectionStart = wdSectionContinuous
            .SaveAs FileName:=Pad & DocName & ".docx", FileFormat:=wdFormatDocument
            .ExportAsFixedFormat OutputFileName:=Pad & DocName & ".pdf", ExportFormat:=wdExportFormatPDF, _
                OpenAfterExport:=True, OptimizeFor:=wdExportOptimizeForPrint, IncludeDocProps:=True, _
                Item:=wdExportDocumentContent, CreateBookmarks:=wdExportCreateHeadingBookmarks
        End With
        ActiveWindow.Close
        Counter = Counter + 1
    Wend

End Sub