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 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72
| Sub Fiche()
Dim wApp As Word.Application
Dim chemin As String
Dim sqlA As String, sqlS As String, sqlB As String, sqlC As String
Dim rsA As DAO.Recordset, rsS As DAO.Recordset, rsB As DAO.Recordset, rsC As DAO.Recordset
Dim db As DAO.Database
Set db = CurrentDb
sqlA = "SELECT * FROM R_Publipostage_Adherents" & _
" LEFT JOIN R_Publipostage_Circuits ON R_Publipostage_Adherents.numero = R_Publipostage_Circuits.numero" & _
" WHERE Nz([R_Publipostage_Circuits.numero],0)=390.3;" 'Renseigner le Numéro adhérent pour éditer son courrier
Set rsA = db.OpenRecordset(sqlA)
Set wApp = New Word.Application
wApp.Visible = True
chemin = CurrentProject.Path
While Not rsA.EOF
With wApp
cptLigneAdr = 0
Set wDoc = wApp.Documents.Open(chemin & "\Modèle-circuits-attribués-2026.docx") 'mettre l'année à jour
cptLigneAdr = cptLigneAdr + 1
wDoc.Bookmarks("LigneAdr" & Format(cptLigneAdr, "00")).Range.Text = rsA.Fields("civilite") & " " & UCase(rsA.Fields("nom_adhe")) & " " & rsA.Fields("prenom")
cptLigneAdr = cptLigneAdr + 1
wDoc.Bookmarks("LigneAdr" & Format(cptLigneAdr, "00")).Range.Text = rsA.Fields("adresse")
If rsA.Fields("addresse2") <> " " Then
cptLigneAdr = cptLigneAdr + 1
wDoc.Bookmarks("LigneAdr" & Format(cptLigneAdr, "00")).Range.Text = rsA.Fields("addresse2")
End If
cptLigneAdr = cptLigneAdr + 1
wDoc.Bookmarks("LigneAdr" & Format(cptLigneAdr, "00")).Range.Text = rsA.Fields("CodePostal") & " " & UCase(rsA.Fields("ville"))
wDoc.Bookmarks("Prenom1").Range.Text = rsA.Fields("Prenom")
sqlC = "SELECT * FROM R_Publipostage_Circuits_Bornes WHERE numero_adhe=" & rsA.Fields("R_Publipostage_Adherents.numero")
Set rsC = db.OpenRecordset(sqlC)
.ActiveDocument.Bookmarks("InfoBornes").Range.Text = rsC.Fields("Informations")
'If Not rsC.EOF Then wDoc.Bookmarks("NumAdherent").Range.Text = rsC.Fields("numero_adhe")
sqlB = "SELECT * FROM R_Publipostage_nombrePR WHERE numero=" & rsA.Fields("R_Publipostage_Adherents.numero")
Set rsB = db.OpenRecordset(sqlB)
.ActiveDocument.Bookmarks("TotalPR").Range.Text = rsB.Fields("Nbr_PR")
If Not rsB.EOF Then wDoc.Bookmarks("NumAdherent").Range.Text = rsB.Fields("numero")
'--- tableau
sqlS = "SELECT * FROM R_Publipostage_Circuits WHERE numero=" & rsA.Fields("R_Publipostage_Adherents.numero")
Set rsS = db.OpenRecordset(sqlS)
With .ActiveDocument.Tables(1)
While Not rsS.EOF
.Rows.Add
.Rows.Last.Cells(1).Range.Text = rsS.Fields("secteur_balirando")
.Rows.Last.Cells(2).Range.Text = UCase(rsS.Fields("Code"))
.Rows.Last.Cells(3).Range.Text = rsS.Fields("nom_pr")
.Rows.Last.Cells(4).Range.Text = UCase(rsS.Fields("depart"))
.Rows.Last.Cells(5).Range.Text = rsS.Fields("balisage")
rsS.MoveNext
Wend
End With
'---
'.ActiveDocument.PrintOut Mettre l'année à jour
.ActiveDocument.SaveAs "C:\Users\balir\BALIRANDO\2026\Publipostage\Attribution circuits\Adhérent unique\" & _
"\Circuits " & Format(Date, "yyyy") & " " & _
rsA.Fields("nom_adhe") & " " & rsA.Fields("prenom") & ".docx"
.ActiveDocument.Close (wdDoNotSaveChanges)
End With
rsA.MoveNext
Wend
rsS.Close: Set rsS = Nothing
rsA.Close: Set rsA = Nothing
db.Close: Set db = Nothing
Set wApp = Nothing
End Sub |
Partager