Enregistrer chaque page en tant que fichier PDF séparé avec des noms du doc

**Mikitars20** · 18/02/2021, 15h38

Bonjour,

J'ai un code qui me permet d'enregistrer les documents word microsoft en pdf séparément qui fonctionne très bien mais, lors de l'enregistrement du document word (avec plusieurs pages) en pdf j'ai : page_1.pdf, pour la première page du document, page_2.pdf pour la deuxième page du document ect....
Et ce que je voudrai c'est avoir le texte qui est dans le paragraphe 18 en plus. Exemple : si dans la première page du doc au paragraphe 18, j'ai Mr Dupont, j'aimerai que lors de l'enregistrement en pdf j'ai : page_Mr Dupont_1.pdf
Si dans la deuxième page au paragraphe 18, j'ai Mr ALEX, j'aimerai avoir : page_Mr ALEX_2.pdf
Merci d'avance et bonne journée.

Voici le code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
Sub SaveAsSeparatePDFs()
    Dim I As Long
    Dim xStr As String
    Dim xPathStr As Variant
    Dim xDictoryStr As String
    Dim xFileDlg As FileDialog
    Dim xStartPage, xEndPage As Long
    Dim xStartPageStr, xEndPageStr As String
    Set xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
    If xFileDlg.Show <> -1 Then
        MsgBox "Please chose a valid directory", vbInformation, "Kutools for Word"
        Exit Sub
    End If
    xPathStr = xFileDlg.SelectedItems(1)
    xStartPageStr = InputBox("Begin saving PDFs starting with page __? " & vbNewLine & "(ex: 1)", "Kutools for Word")
    xEndPageStr = InputBox("Save PDFs until page __?" & vbNewLine & "(ex: 7)", "Kutools for Word")
    If Not (IsNumeric(xStartPageStr) And IsNumeric(xEndPageStr)) Then
        MsgBox "The enterng start page and end page should be number format", vbInformation, "Kutools for Word"
        Exit Sub
    End If
    xStartPage = CInt(xStartPageStr)
    xEndPage = CInt(xEndPageStr)
    If xStartPage > xEndPage Then
        MsgBox "The start page number can't be larger than end page", vbInformation, "Kutools for Word"
        Exit Sub
    End If
    If xEndPage > ActiveDocument.BuiltInDocumentProperties(wdPropertyPages) Then
        xEndPage = ActiveDocument.BuiltInDocumentProperties(wdPropertyPages)
    End If
    For I = xStartPage To xEndPage
        ActiveDocument.ExportAsFixedFormat xPathStr & "\Page_" & I & ".pdf", _
        wdExportFormatPDF, False, wdExportOptimizeForPrint, wdExportFromTo, I, I, wdExportDocumentWithMarkup, _
        False, False, wdExportCreateHeadingBookmarks, True, False, False
    Next
End Sub

Invité · 18/02/2021, 16h40

Envoyé par Mikitars20

Bonjour,

Comment se présenterait un paragraphe 18 ?

**Mikitars20** · 18/02/2021, 17h00

Envoyé par Eric KERGRESSE

Bonjour,

Comment se présenterait un paragraphe 18 ?

Bonjour,

Mr ou Mme "prénom" "Nom"

Voici un exemple en pièce jointe (j'ai du enregistrer sans macro pour pouvoir l'ajouter en pièce jointe)

Invité · 18/02/2021, 18h12

Envoyé par Mikitars20

Cette fonction récupère la chaîne complète :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
 
Function NomPrenom(ByVal DocEnCours As Document, ByVal NumeroDePage As Integer) As String
 
Dim I As Integer
 
    NomPrenom = ""
    With DocEnCours
         With .Tables(NumeroDePage).Range.Cells(2).Range.Paragraphs(17)
              If Len(.Range.Text) > 1 Then
                 For I = 1 To Len(.Range.Text)
                     Select Case Mid(.Range.Text, I, 1)
                            Case "*", "?", ",", ".", "@", Chr(10), Chr(11), Chr(13)
 
                            Case Else
                                  NomPrenom = NomPrenom & Mid(.Range.Text, I, 1)
                     End Select
                 Next I
              End If
        End With
    End With
 
End Function

Dans votre code principal :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
 
        For I = xStartPage To xEndPage
            NomPrenom2 = xPathStr & "\Page_" & NomPrenom(ActiveDocument, I) & "_" & I & ".pdf" '
            ActiveDocument.ExportAsFixedFormat NomPrenom2, _
            wdExportFormatPDF, False, wdExportOptimizeForPrint, wdExportFromTo, I, I, wdExportDocumentWithMarkup, _
            False, False, wdExportCreateHeadingBookmarks, True, False, False
        Next

**Mikitars20** · 18/02/2021, 18h42

Merci infiniment Eric. Je viens d'essayer et c'est exactement ce que je voulais.

Dernière petite info, si jamais j'ai besoin d'enlever le Mr ou Mme et garder que le prénom et le nom, quel code devront nous appliquer .
Je vous remercie .

Invité · 18/02/2021, 18h47

Envoyé par Mikitars20

Il faut utiliser la fonction Split :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
 
 
Function NomPrenom(ByVal DocEnCours As Document, ByVal NumeroDePage As Integer) As String
 
Dim NomPrenomTableau As Variant
 
    NomPrenom = ""
    With DocEnCours
             With .Tables(NumeroDePage).Range.Cells(2).Range.Paragraphs(17)
                  NomPrenomTableau = Split(Mid(.Range.Text, 1, Len(.Range.Text) - 1), " ")
                  If UBound(NomPrenomTableau) >= 2 Then
                      NomPrenom = NomPrenomTableau(1) & " " & NomPrenomTableau(2)
                  End If
        End With
    End With
 
End Function

**Mikitars20** · 18/02/2021, 18h55

Merci beaucoup

Invité · 19/02/2021, 04h30

Envoyé par Mikitars20

Cette variante

répond au cas Jean Michel DUPONT :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
 
Function NomPrenom(ByVal DocEnCours As Document, ByVal NumeroDePage As Integer) As String
 
Dim I As Integer, CaractereDebut As Integer
Dim NomPrenomTableau As Variant
 
    NomPrenom = ""
    With DocEnCours
         With .Tables(NumeroDePage).Range.Cells(2).Range.Paragraphs(17)
              If Len(.Range.Text) > 1 Then
                 NomPrenomTableau = Split(.Range.Text, " ")
                 CaractereDebut = Len(NomPrenomTableau(0)) + 2
                 For I = CaractereDebut To Len(.Range.Text)
                     Select Case Mid(.Range.Text, I, 1)
                            Case "*", "?", ",", ".", "@", Chr(10), Chr(11), Chr(13)
 
                            Case Else
                                  NomPrenom = NomPrenom & Mid(.Range.Text, I, 1)
                     End Select
                 Next I
                 NomPrenom = Trim(NomPrenom)
              End If
        End With
    End With
 
End Function

**Mikitars20** · 19/02/2021, 10h48

Ah oui je n'y avais pas pensé. Merci beaucoup

**SunCanBurn** · 09/07/2024, 17h12

Bonjour,

Je suis désolé de faire ressortir ce sujet mais il répondait partiellement à un de mes sujets du moment.
Je n'arrive juste pas à adapter la formule pour le nommage du fichier pdf.
J'avoue que les macros sur EXCEL ça me parle mais je découvre WORD et j'ai du mal à me calibrer sur "comment faire comprendre à l'outil quel champ il doit prendre en variable".
Si vous avez une seconde pour m'expliquer ou à quoi ressemblerait la partie macro ?
Je mets en PJ le fichier, le nom de sauvegarde doit être la partie 1234

Merci par avance pour votre aide.

PS : la partie découpe et sauvegarde page par page en PDF fonctionne nickel sinon.

Bonne journée,TEST 123.docx

**Nain porte koi** · 10/07/2024, 00h31

Hello,

le doc que vous avez joint est le document principal de fusion, et, si je ne me trompe pas, les codes ci dessus sont pour le document final.

Enregistrer chaque page en tant que fichier PDF séparé avec des noms du doc [Toutes versions]

VBA Word

Discussions similaires

Partager

Partager