Discussion :

[Mikitars20]

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é]

Bonjour,

Comment se présenterait un paragraphe 18 ?

[Mikitars20]

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é]

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]

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é]

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]

Merci beaucoup

[Invité]

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]

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