Microsoft 365 Générateur de lettres personnalisées à partir d'une liste

[Loïc Ch.]

Bonsoir à tous,

A partir d'une liste indiquant le prénom, le nom et l'adresse de différentes personnes, je dois générer une lettre personnalisée, car reprenant ces informations en haut à gauche
Le fichier Excel attaché a deux onglets : liste et lettre.
Idéalement, l'ensemble des lettres doit constitué un seul fichier PDF.

Qui peut/veut m'aider ?

N'hésitez pas à me questionner si ma demande n'est pas suffisamment claire ou explicite.

Merci d'avance.

Loïc

 

[kiki29]

Salut, à télécharger puis consulter pour la partie PDF : Liste Contributions PDF

 

[Loïc Ch.]

Bonjour Kiki29,

Merci pour votre réponse.
Je suis cependant plutôt dans l'attente du fichier Excel modifié, prêt à être utilisé ;-)

La lettre attendue est une lettre recto verso, dont le verso est simplement l'image de la 2e page de l'onglet lettre.

Merci d'avance pour votre aide.

Bonne journée.

Loïc

 

[job75]

Bonjour Loïc Ch., kiki29, le forum,,

Voyez le fichier joint et la macro du bouton :

Sub Lettres_PDF()
Dim t, chemin$, F As Worksheet, i&
t = Timer
Application.ScreenUpdating = False
chemin = ThisWorkbook.Path & "\Dossier lettres\"
If Dir(chemin, vbDirectory) = "" Then MkDir chemin 'création du sous-dossier
Set F = Sheets("Lettre personnalisee")
With Sheets("Liste").[A1].CurrentRegion
    For i = 2 To .Rows.Count
        F.Range("X4") = .Cells(i, 1) & " " & .Cells(i, 2)
        F.Range("Y5") = .Cells(i, 3)
        F.Range("Y6") = .Cells(i, 4)
        F.ExportAsFixedFormat xlTypePDF, chemin & F.Range("X4")
    Next
End With
MsgBox i - 2 & " fichiers PDF créés en " & Format(Timer - t, "0.00 \sec")
End Sub

A+

 

[Loïc Ch.]

Bonsoir Job75,

Merci bcp pour la macro, c'est juste parfait !

La discussion est donc close de mon côté.

Bonne soirée à tous.

Loïc

 

[job75]

Vous avez dit :

Idéalement, l'ensemble des lettres doit constitué un seul fichier PDF.

Alors utilisez cette nouvelle macro :

Sub Lettres_PDF()
Dim t, chemin$, F As Worksheet, P As Range, i&, a()
t = Timer
Application.ScreenUpdating = False
Application.DisplayAlerts = False
chemin = ThisWorkbook.Path
Set F = Sheets("Lettre personnalisee")
Set P = Sheets("Liste").[A1].CurrentRegion
For i = 2 To P.Rows.Count
    F.Copy After:=Sheets(Sheets.Count) 'nouvelle feuille
    With ActiveSheet
        .Range("X4") = P(i, 1) & " " & P(i, 2)
        .Range("Y5") = P(i, 3)
        .Range("Y6") = P(i, 4)
        ReDim Preserve a(i - 2)
        a(i - 2) = .Name
    End With
Next
Sheets(a).Select 'toutes les feuilles créées sont sélectionnées
ActiveSheet.ExportAsFixedFormat xlTypePDF, chemin & "\Fichier PDF.pdf"
Sheets(a).Delete 'toutes les feuilles créées sont supprimées
P.Parent.Select
MsgBox i - 2 & " feuilles créées en " & Format(Timer - t, "0.0 \sec")
End Sub

Toutes les pages du fichier PDF peuvent être imprimées recto verso les unes à la suite des autres.