Fusion Word-Access avec enregistrement .doc

Bonjour,
Vous pouvez vous inspirer des procédures ci-dessous.
ça fait un peu bricolage car je ne suis pas informaticien, mais ça
fonctionne parfaitement
sous Access 2007 et c'est tout ce que je demande...
Il faudra bien sur adapter tout ça à vos besoins spécifiques.
Bon courage


***********************************************************************************
Public Sub ImprimeNotification()

Dim qdf As DAO.QueryDef
Dim rst As DAO.Recordset
Dim oWrd As Object
Dim VarDataPath As String
Dim NbEnreg As Integer


On Error GoTo ImprimeNotification_Error

Set qdf = CurrentDb.QueryDefs("Qry_ImpNotification")

Set rst = qdf.OpenRecordset
rst.MoveLast
NbEnreg = rst.RecordCount
rst.MoveFirst

If NbEnreg > 0 Then


Select Case MsgBox("Vous allez imprimer " & NbEnreg & "
notification(s)." _
& vbCrLf & vbCrLf & "Les notifications des enfants
sans " & vbCrLf & _
"représentants légaux ne seront pas imprimées.",
vbYesNo Or vbInformation Or vbDefaultButton1)
Case vbNo
Exit Sub

Case vbYes

'Call PrintOut


Set oWrd = CreateObject("word.application")
On Error GoTo err_QuitImprimenotification

'Appel de la fonction CreatRepertoire pour créer le
sous-repertoire "Transmis le ..."
CreatRepertoire

While Not rst.EOF

With oWrd

.Documents.Add Template:=GetDataPath &
"notification.doc"

.ActiveDocument.Bookmarks("RL_civ_court").Select
.Selection.TypeText Text:=UCase(rst!rl_civ_court)

.ActiveDocument.Bookmarks("RL_civ_long").Select
.Selection.TypeText Text:=(rst!rl_civ_long)

.ActiveDocument.Bookmarks("RL_Nom").Select
.Selection.TypeText Text:=UCase(rst!Rl_nom)

.ActiveDocument.Bookmarks("RL_Prenom").Select
.Selection.TypeText Text:=IIf((rst!rl_Prenom) <> "",
UCase(rst!rl_Prenom), " ")

.ActiveDocument.Bookmarks("RL_ad1").Select
.Selection.TypeText Text:=IIf((rst!RL_ad1) <> "",
UCase(rst!RL_ad1), " ")

.ActiveDocument.Bookmarks("RL_ad2").Select
.Selection.TypeText Text:=IIf((rst!RL_ad2) <> "",
UCase(rst!RL_ad2), " ")

.ActiveDocument.Bookmarks("RL_cpville").Select
.Selection.TypeText Text:=IIf((rst!RL_cpville) <> "",
UCase(rst!RL_cpville), " ")

.ActiveDocument.Bookmarks("El_nom").Select
.Selection.TypeText Text:=UCase(rst!EL_Nom)

.ActiveDocument.Bookmarks("El_prenom").Select
.Selection.TypeText Text:=UCase(rst!EL_Prenom)

.ActiveDocument.Bookmarks("Dnaiss_eleve").Select
.Selection.TypeText Text:=CStr(rst!Dnaiss_eleve)

.ActiveDocument.Bookmarks("origine_scolaire").Select
.Selection.TypeText Text:=UCase(rst!Origine_scolaire)

.ActiveDocument.Bookmarks("decision").Select
.Selection.TypeText Text:=IIf((rst!Decision) <> "",
(rst!Decision), " ")

.ActiveDocument.Bookmarks("RL_civ_long2").Select
.Selection.TypeText Text:=(rst!rl_civ_long)

.ActiveDocument.Bookmarks("dateretour").Select
.Selection.TypeText Text:=CStr(rst!Dateretour)


'pour "publier" le document au format PDF ou Word dans
le sous-répertoire "transmis"
VarDataPath = GetDataPath & "transmis le " &
DateCreatRep & ""

'Au format PDF
.ActiveDocument.ExportAsFixedFormat (VarDataPath &
(rst!Rl_nom) & " (" & (rst!Id_RepLegal) & " ) " & _
(rst!EL_Nom) & " ("
& (rst!Id_eleve) & ")"), wdExportFormatPDF

'Au format Word
'.ActiveDocument.SaveAs (VarDataPath & (rst!Rl_nom) & "
(" & (rst!Id_RepLegal) & " ) " & _
(rst!el_nom) & " (" & (rst!id_eleve) & ")"),
wdFormatDocument

VarDataPath = GetDataPath
.ActiveDocument.PrintOut Background:úlse

End With

rst.MoveNext
Wend

Call MajDateEnvoiNotification



ExitImprimenotification:
oWrd.Application.Quit savechanges:=wdDoNotSaveChanges
Set oWrd = Nothing
Set rst = Nothing
Set qdf = Nothing
Exit Sub

err_QuitImprimenotification:
MsgBox Err.Description
Resume ExitImprimenotification
End Select

Else
MsgBox "Aucune notification à imprimer !", vbCritical
End If

On Error GoTo 0
Exit Sub

ImprimeNotification_Error:

MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure
ImprimeNotification of Module Sub Imprimer lettres"
End Sub

***********************************************************************************
Public Sub MajDateEnvoiNotification()

Dim Réponse1 As String
Dim Réponse2 As String

Réponse1 = MsgBox(" L'impression est-elle correcte ? ", vbYesNo)

If Réponse1 = vbYes Then
DoCmd.SetWarnings False
'Insère la date de l'impression dans le champ Date_Imp_Decision
DoCmd.RunSQL "UPDATE TblDossierEleve SET
TblDossierEleve.Date_Imp_Decision = Now()" & _
"WHERE (((TbldossierEleve.imp_decision) = true) AND
((tbldossiereleve.date_imp_decision) is null));"
'Remet à False de champ Imp_Decision
DoCmd.RunSQL "UPDATE TblDossierEleve SET
TblDossierEleve.Imp_Decision = false " & _
"WHERE (((TbldossierEleve.imp_decision) = true) AND
((tbldossiereleve.date_imp_decision) <> null));"

DoCmd.SetWarnings True

Else
Réponse2 = MsgBox("Voulez-vous relancer l'impression MAINTENANT ?",
vbYesNo)
If Réponse2 = vbYes Then
Call ImprimeNotification
Else
End If

End If
Réponse1 = ""
Réponse2 = ""

***********************************************************************************
Public DateCreatRep As String

Function GetDataPath()
Dim Chemin As String, i As Integer
Chemin = CurrentDb.Name
i = Len(Chemin)
While Mid$(Chemin, i, 1) <> ""
i = i - 1
Wend
GetDataPath = Mid$(Chemin, 1, i)

End Function

***********************************************************************************
Public Function CreatRepertoire()
' création du sous répertoire "transmis le " + date + heure + min dans le
répertoire courant
Dim j As Integer, M As Integer, A As Integer, H As Integer, Mn As
Integer

j = CInt(Left$(Now, 2))
M = CInt(Mid$(Now, 4, 2))
A = CInt(Mid$(Now, 7, 4))
H = CInt(Mid$(Now, 12, 2))
Mn = CInt(Mid$(Now, 15, 2))

DateCreatRep = j & " " & M & " " & A & " à " & H & " h " & Mn & " mn"

On Error Resume Next ' Début de la gestion d'erreur : si
erreur,exécuter l 'instruction suivante
MkDir GetDataPath & "transmis le " & DateCreatRep & "" ' création du
répertoire"
If Err.Number <> 0 Then ' le code d'erreur n'est pas 0 :
l'instruction précédente a provoqué une erreur
' MsgBox "Le répertoire existe déjà !"
End If
On Error GoTo 0 ' Fin de la gestion d'erreur

End Function

***********************************************************************************

End Sub
"Richard_35" <Richard35@discussions.microsoft.com> a écrit dans le message
de news:3B039B82-1975-4C18-BBA3-2D348DD8B902@microsoft.com...

Bonjour à tous,

Sous Access 2003, contexte :
- 1 document de fusion Word (publipostage) avec une source de données
étant
une requête Access comportant 3 enregistrements (c'est un exemple) :
Structure :
. Id_client
. Nom_client
Données :
1 toto
2 titi
3 tata

Je souhaite, sous Access donc :
- déclencher le document de fusion ;
- enregistrer, dans un répertoire, autant de documents Word que de
clients,
donc, dans l'exemple, 3 documents xxx.doc distincts, mais avec xxx > Id_client.

Merci d'avance de votre aide.
Richard.