Discussion :

[saidm]

J'ai entraîne de terminer mon application en Microsoft Visual Basic 6.0 . J'ai créé un document principal de fusion publipostage basé sur ma requête Access dans un button de command. Qui permet d'appeler la requête et afficher des informations dans un document Word existe déjà. Chaque lignes des informations dans une page document Word.

Les codes :

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
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
 général déclarations
Private w As Word.Application
 
Private Sub Command1_Click()
Set w = New Word.Application
w.Visible = False
If Dir("c:\aa.doc") = "aa.doc" Then Kill "c:\aa.doc" 'Rechercher dans l'application path  si document nommée "aa" existe supprimer le
FileCopy App.Path & "\traveau_pinible1.doc", "c:\aa.doc" 'Copie document traveau_pinible1.doc et nommée "aa"
w.Documents.Open ("c:\aa.doc") 'Ouvrir document "aa"
w.ActiveDocument.Bookmarks(1).Range = Date 'date de jour
w.ActiveDocument.MailMerge.MainDocumentType = wdFormLetters
 
'Déterminer la connexion avec la basse donne et requête
' fonctionnaire1.mdb = basse donne
'liste_b_t_p1 = requête
 
w.ActiveDocument.MailMerge.OpenDataSource (App.Path & "\fonctionnaire1.mdb"), ConfirmConversions:= _
False, ReadOnly:=False, LinkToSource:=True, AddToRecentFiles:=False, _
PasswordDocument:="", PasswordTemplate:="", WritePasswordDocument:="", _
WritePasswordTemplate:="", Revert:=False, Format:=wdOpenFormatAuto, Connection:= _
"Provider=Microsoft.Jet.OLEDB.4.0;Password="""";User ID=Admin;Data Source=fonctionnaire1.mdb;Mode=Read;Extended Properties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";Jet OLEDB:Engin" _
 , SQLStatement:="SELECT * FROM `liste_b_t_p1`", SQLStatement1:="", SubType:=wdMergeSubTypeAccess
 
'Spécifier position dans document word
 
  w.Selection.MoveDown Unit:=wdLine, Count:=20
  w.Selection.MoveRight Unit:=wdCell
 
'Afficher les signets
'    '"""nom_et_prnom""" = champ de requête ..........
 
w.ActiveDocument.Fields.Add Range:=Selection.Range, Type:=wdFieldMergeField, text:="""nom_et_prnom"""
    w.Selection.MoveRight Unit:=wdCell
    w.Selection.MoveRight Unit:=wdCell
 w.ActiveDocument.Fields.Add Range:=Selection.Range, Type:=wdFieldMergeField, Text:="""grade_f_a"""
    w.Selection.MoveRight Unit:=wdCell
    w.Selection.MoveRight Unit:=wdCell
 w.ActiveDocument.Fields.Add Range:=Selection.Range, Type:=wdFieldMergeField, Text:="""matricule"""
     w.Selection.MoveRight Unit:=wdCell
     w.Selection.MoveRight Unit:=wdCell
w.ActiveDocument.Fields.Add Range:=Selection.Range, Type:=wdFieldMergeField, Text:="""cin"""
    w.Selection.MoveRight Unit:=wdCell
    w.Selection.MoveRight Unit:=wdCell
w.ActiveDocument.Fields.Add Range:=Selection.Range, Type:=wdFieldMergeField, Text:="""f"""
    With w.ActiveDocument.MailMerge
        .Destination = wdSendToPrinter
        .SuppressBlankLines = True
 
        With .DataSource
            .FirstRecord = wdDefaultFirstRecord
            .LastRecord = wdDefaultLastRecord
        End With
        .Execute Pause:=False
    End With
    w.Selection.Find.ClearFormatting
    w.Selection.Find.Replacement.ClearFormatting
 
w.ActiveDocument.Save
w.ActiveDocument.PrintOut
w.Quit
Set w = Nothing
End sub

Le problème : Quand je click sur le button la 1er fois tous ça marche très bien . si je click la 2 eme fois une erreur s'affiche :
Erreur d'exécution '462'
Le serveur distant n'existe pas ou n'est pas disponible

Débogage :

Code :

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

w.ActiveDocument.Fields.Add Range:=Selection.Range, Type:=wdFieldMergeField, Text:="""nom_et_prnom"""

j’ai pas trouver l’erreur . et je cherche l' aide et merci à tous

[SfJ5Rpw8]

évite d'utiliser Active document essai un truc du genre :

Code :

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

1
2
3
4
5
6
7
8
9
 
Dim oDoc As Word.Document
set oDoc = w.Documents.Open ("c:\aa.doc") 'Ouvrir document "aa"
oDoc.Bookmarks(1).Range = Date 'date de jour
....
..
 
set oDoc = Nothing 'libére l'objet document....
end sub

[saidm]

Salut bbil et merci pour la réponse
Après la modification le problème reste lui-même


Les codes après la modification :

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
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
 
Dim d As Word.Document
Set w = New Word.Application
w.Visible = False
If Dir("c:\aa.doc") = "aa.doc" Then Kill "c:\aa.doc"
FileCopy App.Path & "\traveau_pinible1.doc", "c:\aa.doc"
Set d = w.Documents.Open("c:\aa.doc")
d.Bookmarks(1).Range = Date 'date de jour
d.MailMerge.MainDocumentType = wdFormLetters
d.MailMerge.OpenDataSource (App.Path & "\fonctionnaire1.mdb"), ConfirmConversions:= _
False, ReadOnly:=False, LinkToSource:=True, AddToRecentFiles:=False, _
PasswordDocument:="", PasswordTemplate:="", WritePasswordDocument:="", _
WritePasswordTemplate:="", Revert:=False, Format:=wdOpenFormatAuto, Connection:= _
"Provider=Microsoft.Jet.OLEDB.4.0;Password="""";User ID=Admin;Data Source=fonctionnaire1.mdb;Mode=Read;Extended Properties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";Jet OLEDB:Engin" _
 , SQLStatement:="SELECT * FROM `liste_b_t_p1`", SQLStatement1:="", SubType:=wdMergeSubTypeAccess
 
  w.Selection.MoveDown Unit:=wdLine, Count:=20
  w.Selection.MoveRight Unit:=wdCell
 
 
d.Fields.Add Range:=Selection.Range, Type:=wdFieldMergeField, Text:="""nom_et_prnom"""
    w.Selection.MoveRight Unit:=wdCell
    w.Selection.MoveRight Unit:=wdCell
 d.Fields.Add Range:=Selection.Range, Type:=wdFieldMergeField, Text:="""grade_f_a"""
    w.Selection.MoveRight Unit:=wdCell
    w.Selection.MoveRight Unit:=wdCell
d.Fields.Add Range:=Selection.Range, Type:=wdFieldMergeField, Text:="""matricule"""
     w.Selection.MoveRight Unit:=wdCell
     w.Selection.MoveRight Unit:=wdCell
d.Fields.Add Range:=Selection.Range, Type:=wdFieldMergeField, Text:="""cin"""
    w.Selection.MoveRight Unit:=wdCell
    w.Selection.MoveRight Unit:=wdCell
d.Fields.Add Range:=Selection.Range, Type:=wdFieldMergeField, Text:="""f"""
    With d.MailMerge
        .Destination = wdSendToPrinter
        .SuppressBlankLines = True
 
        With .DataSource
            .FirstRecord = wdDefaultFirstRecord
            .LastRecord = wdDefaultLastRecord
        End With
        .Execute Pause:=False
    End With
    w.Selection.Find.ClearFormatting
    w.Selection.Find.Replacement.ClearFormatting
 
d.Save
d.PrintOut
w.Quit
Set d = Nothing

Débogage

Code :

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

d.Fields.Add Range:=Selection.Range, Type:=wdFieldMergeField, Text:="""nom_et_prnom"""

[saidm]

En fin j’ai trouvé une solution . il faut ajouter les champs de fusion dans document word merci à tous

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
36
 
Set w = New Word.Application
With w
w.Visible = False
If Dir("c:\aa.doc") = "aa.doc" Then Kill "c:\aa.doc" 'Rechercher dans l'application path  si document nommée "aa" existe supprimer le
FileCopy App.Path & "\nom document.doc", "c:\aa.doc" 'Copie document et nommée "aa"
.Documents.Open ("c:\aa.doc") 'Ouvrir document "aa"
.ActiveDocument.Bookmarks(1).Range = Date 'date de jour
.ActiveDocument.MailMerge.MainDocumentType = wdFormLetters
'Déterminer la connexion avec la basse donne et requête
' fonctionnaire1.mdb = basse donne
'liste_b_t_p1 = requête
.ActiveDocument.MailMerge.OpenDataSource (App.Path & "\fonctionnaire1.mdb"), ConfirmConversions:= _
False, ReadOnly:=False, LinkToSource:=True, AddToRecentFiles:=False, _
PasswordDocument:="", PasswordTemplate:="", WritePasswordDocument:="", _
WritePasswordTemplate:="", Revert:=False, Format:=wdOpenFormatAuto, Connection:= _
"Provider=Microsoft.Jet.OLEDB.4.0;Password="""";User ID=Admin;Data Source=fonctionnaire1.mdb;Mode=Read;Extended Properties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";Jet OLEDB:Engin" _
 , SQLStatement:="SELECT * FROM `liste_b_t_p1`", SQLStatement1:="", SubType:=wdMergeSubTypeAccess
 
  With .ActiveDocument.MailMerge
        .Destination = wdSendToPrinter
        .MailAsAttachment = False
       .MailAddressFieldName = ""
              .MailSubject = ""
        .SuppressBlankLines = True
        With .DataSource
            .FirstRecord = wdDefaultFirstRecord
            .LastRecord = wdDefaultLastRecord
        End With
        .Execute Pause:=True
    End With
 
 .ActiveDocument.Close wdDoNotSaveChanges
.Quit
End With
Set w = Nothing