Discussion :

[AidezMoiSvp]

Bonjour,

Aidez moi svp je n'en peux plus !

Je fais un publipostage d'access vers word et j'ai un message d'erreur : "Serveur distant non disponible...".

J'ai déjà fait des recherches et j'ai vu qu'il fallait indiquer l'objet avant chaque opération (si j'ai bien compris).

J'ai donc ce 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
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
73
74
75
76
77
78
Set ObjWord = New Word.Application
Set DocWord = ObjWord.Documents.Add("Z:\Nouveau_Doc\Analyse.dotx")
DocWord.Application.Visible = True
 
 
ObjWord.Selection.GoTo what:=wdGoToBookmark, Name:="sgtClassement"
ObjWord.Selection.InsertAfter vbCrLf
ObjWord.Selection.MoveDown
 
'Création d'autant de tableau qu'il y a de lots et en créant autant de ligne par tableau qu'il y a de candidats par lots.
For nbLot = 1 To nbLot
 
    sqlLibelleLot = "SELECT Tbl_Lot.Libelle_Lot FROM Tbl_Lot WHERE Tbl_Lot.ID_Marche = 34 AND Tbl_Lot.Numero_Lot = " & nbLot
 
    Set dbLibelleLot = CurrentDb
    Set rsLibelleLot = dbLibelleLot.OpenRecordset(sqlLibelleLot)
 
    nbLigLot = DCount("[ID_Classement]", "Tbl_Classement_Entreprise", "[Numero_Lot] = " & nbLot & " and [ID_Marche] = 34") + 1
 
    ObjWord.Selection = "Lot n° " & nbLot & " : " & rsLibelleLot.Fields("Libelle_Lot")
    ObjWord.Selection.InsertAfter vbCrLf
    ObjWord.Selection.MoveDown
    ObjWord.Selection.Tables.Add Range:=Selection.Range, numrows:=nbLigLot, numcolumns:=3
    ObjWord.ActiveDocument.Tables(nbLot + nbTableauWord).Cell(1, 1).Range.Text = "N° classement"
    ObjWord.ActiveDocument.Tables(nbLot + nbTableauWord).Cell(1, 2).Range.Text = "N° pli"
    ObjWord.ActiveDocument.Tables(nbLot + nbTableauWord).Cell(1, 3).Range.Text = "Dénomination"
    ObjWord.Selection.MoveDown Unit:=wdLine, Count:=nbLigLot
    ObjWord.Selection.InsertAfter vbCrLf
    ObjWord.Selection.MoveDown
 
    rsLibelleLot.Close
    Set rsLibelleLot = Nothing
    dbLibelleLot.Close
    Set dbLibelleLot = Nothing
 
Next nbLot
 
 
 
On Error Resume Next 
 
For nbLot = 1 To nbLot
 
    nbLigLot = DCount("[ID_Classement]", "Tbl_Classement_Entreprise", "[Numero_Lot] = " & nbLot & " and [ID_Marche] = 34") + 1
 
            sqlClassement = "SELECT Tbl_Classement_Entreprise.Numero_Depot, Tbl_Classement_Entreprise.Numero_Lot, Tbl_Classement_Entreprise.Classement, Tbl_Entreprise2.Denomination_Entreprise, Tbl_Entreprise2.Adresse_Entreprise, Tbl_Entreprise2.Code_Postal_Entreprise, Tbl_Entreprise2.Ville_Entreprise, Tbl_Classement_Entreprise.ID_Entreprise, Tbl_Classement_Entreprise.ID_marche FROM Tbl_Classement_Entreprise INNER JOIN Tbl_Entreprise2 ON Tbl_Classement_Entreprise.ID_Entreprise = Tbl_Entreprise2.ID_Entreprise WHERE Tbl_Classement_Entreprise.Numero_Lot =" & nbLot & "AND Tbl_Classement_Entreprise.ID_marche=34 ORDER BY Tbl_Classement_Entreprise.Classement"
            Set dbClassement = CurrentDb
            Set rsClassement = dbClassement.OpenRecordset(sqlClassement)
            While Not rsClassement.EOF
 
 
 
        For nbLigLot = 1 To nbLigLot + 1
 
 
            ObjWord.ActiveDocument.Tables(nbLot).Cell(nbLigLot + 1, 1).Range.Text = rsClassement.Fields("Classement")
            ObjWord.ActiveDocument.Tables(nbLot).Cell(nbLigLot + 1, 2).Range.Text = rsClassement.Fields("Numero_Depot")
            ObjWord.ActiveDocument.Tables(nbLot).Cell(nbLigLot + 1, 3).Range.Text = rsClassement.Fields("Denomination_Entreprise") & vbCrLf & rsClassement.Fields("Adresse_Entreprise") & vbCrLf & rsClassement.Fields("Code_Postal_Entreprise") & " " & rsClassement.Fields("Ville_Entreprise")
 
            rsClassement.MoveNext
 
 
        Next nbLigLot
 
 
 
            Wend
            rsClassement.Close
            Set rsClassement = Nothing
            dbClassement.Close
            Set dbClassement = Nothing
 
Next nbLot
 
ObjWord.Selection.GoTo what:=wdGoToBookmark, Name:="sgtCandidat"
ObjWord.Selection.InsertAfter vbCrLf
ObjWord.Selection.MoveDown
ObjWord.Selection.Paste

Petites explications :
1° je joue la macro avec F5 = pas de soucis
2° je rejoue la macro avec F5 = message d'erreur
3° je rejoue de nouveau la macro = pas de soucis
4° je rejoue la macro avec F5 = message d'erreur
...

Bref j'ai remarqué qu'il fallait que j'appuie sur le bouton "Stop" en vba avec de rejouer ma macro pour pas qu'il y ait de soucis.

Quelqu'un peut-il m'aider ?

ps : l'erreur se produit sur la ligne 23.



Merci

[Arkham46]

Bonjour,

J'ai déjà fait des recherches et j'ai vu qu'il fallait indiquer l'objet avant chaque opération (si j'ai bien compris).

Effectivement ça évite que des objets ne soient pas correctement libérés.

Il en reste au moins un (sur la ligne en erreur justement) :

Code :

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

ObjWord.Selection.Tables.Add Range:=Selection.Range, numrows:=nbLigLot, numcolumns:=3

à corriger en :

Code :

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

ObjWord.Selection.Tables.Add Range:=ObjWord.Selection.Range, numrows:=nbLigLot, numcolumns:=3

[AidezMoiSvp]

Merci beaucoup !

J'avais déjà essayé mais j'avais oublié de mettre "objword" après "range:=" !!