Discussion :

[GGN44]

Bonjour et bonne année 2017 à toutes et à tous,

Je vous explique mon problème :
J'ai une base access 2010, je dois générer un document Word à partir de 2 requêtes. J'ai écris un module VBA dans mon application access . Le document Word se créer correctement sauf les 2 premières lignes pour les quelles je veux une trame de fond en jaune. Dans mon code j'ai mis volontairement que l'objet soit visible, ce qui me permet de suivre le remplissage du document ligne par ligne. Cette trame de fond ce met bien mais disparaît après l'écriture des lignes suivantes. Je n'ai jamais fait du Word piloté par Access mais beaucoup d'Excel et je suis donc un peu novice sur ce sujet.
Je vous joins mon 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
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
Dim WordObj As Object
Set WordObj = CreateObject("Word.Application.8")
'Pour afficher Word
WordObj.Visible = True
'Ajoute un document
WordObj.Documents.Add
 
Dim rec1 As Recordset
Dim rec2 As Recordset
 
'Lecture premier fichier
Set rec1 = CurrentDb.OpenRecordset("RequêtePlateauxT1_HG_Amendes_D", dbOpenSnapshot)
 
'Ecriture des 2 premieres lignes avec fond jaune
With WordObj.Selection
    .TypeText Text:="1er TOUR COUPE FESTIVAL U13 ET J.MERCIER"
    .TypeParagraph
    .TypeText Text:=Format(rec1.Fields(0), "dddd d mmmm yyyy")
    .MoveLeft Unit:=wdCharacter, Count:=23
    .MoveUp Unit:=wdLine, Count:=1
    .MoveRight Unit:=wdCharacter, Count:=51, Extend:=wdExtend
    .MoveDown Unit:=wdLine, Count:=1, Extend:=wdExtend
    .Font.Name = "Times New Roman"
    .Font.Size = 18
    .ParagraphFormat.Alignment = wdAlignParagraphCenter
    .Shading.Texture = wdTextureNone
    .Shading.ForegroundPatternColor = wdColorAutomatic
    .Shading.BackgroundPatternColor = wdColorYellow
    .MoveDown Unit:=wdLine, Count:=1, Extend:=wdMove
    .Shading.Texture = wdTextureNone
    .Shading.ForegroundPatternColor = wdColorAutomatic
    .Shading.BackgroundPatternColor = -603914241
    .TypeParagraph
    .TypeParagraph
End With
 
'Rappel du règlement
With WordObj.Selection
    .Font.Name = "Times New Roman"
    .Font.Size = 10
    .ParagraphFormat.Alignment = 0
    .ParagraphFormat.Shading.BackgroundPatternColor = RGB(255, 255, 255)
    .Font.Underline = wdUnderlineSingle
    .Font.Bold = True
    .Range.HighlightColorIndex = wdTurquoise
    .TypeText Text:="Rappel : Article - 160  Nombre de joueurs Mutation"
    .TypeParagraph
    .Font.Reset
    .Range.HighlightColorIndex = wdNoHighlight
    .TypeText Text:="1. Dans toutes les compétitions officielles et pour toutes les catégories d’âge, le nombre de joueurs titulaires d’une licence  Mutation  pouvant être inscrits sur la feuille de match est limité à six dont deux maximum ayant changé de club hors période normale au sens de l’article 92.1 des présents règlements."
    .TypeParagraph
    .Font.Color = wdColorRed
    .Font.Bold = True
    .Range.HighlightColorIndex = wdYellow
    .TypeText Text:="Toutefois, pour les pratiques à effectif réduit, le nombre de joueurs titulaires d’une licence Mutation pouvant être inscrits sur la feuille de match est limité à quatre dont deux maximum ayant changé de club hors période normale au sens de l’article 92.1 des présents règlements."
    .TypeParagraph
    .Font.Color = wdColorBlack
    .Font.Bold = False
    .Range.HighlightColorIndex = wdNoHighlight
    .TypeText Text:="2. Le nombre de joueurs titulaires d’une licence ayant changé de club hors période normale au sens de l’article 92.1 des présents règlements pouvant être inscrits sur la feuille de match peut être diminué ou augmenté dans les conditions fixées par les articles 45 et 47 du Statut de l’Arbitrage et 164 des présents règlements. En tout état de cause, quel que soit le nombre de joueurs mutés accordé, le nombre de joueurs titulaires d’une licence  Mutation ayant changé de club hors période normale inscrits sur la feuille de match est limité à deux maximum."
    .TypeParagraph
End With
 
 
'Ecriture des équipes disqualifiées
 
With WordObj.Selection
    .Font.Underline = wdUnderlineSingle
    .Font.Bold = True
    .Range.HighlightColorIndex = wdTurquoise
    .TypeText Text:="Les équipes suivantes sont disqualifiées (amendes = " & rec1.Fields(7) & "€  par équipe):"
    .ParagraphFormat.SpaceBefore = 0
    .ParagraphFormat.SpaceBeforeAuto = False
    .ParagraphFormat.SpaceAfter = 0
    .ParagraphFormat.SpaceAfterAuto = False
    .Font.Reset
    .Range.HighlightColorIndex = wdNoHighlight
End With
Do Until rec1.EOF = True
 
With WordObj.Selection
    .TypeParagraph
    .ParagraphFormat.SpaceBefore = 0
    .ParagraphFormat.SpaceBeforeAuto = False
    .ParagraphFormat.SpaceAfter = 0
    .ParagraphFormat.SpaceAfterAuto = False
    .TypeText Text:=rec1.Fields(1) & ":" & rec1.Fields(2) & "-" & "Poule : " & rec1.Fields(3) & " " & rec1.Fields(4) & " Motif : " & rec1.Fields(6)
End With
 
rec1.MoveNext
Loop
 
'Lecture du 2eme fichier
Set rec2 = CurrentDb.OpenRecordset("RequêtePlateauxT1_HG_Amendes_F", dbOpenSnapshot)
 
'Ecriture des équipes forfaits
With WordObj.Selection
    .TypeParagraph
    .TypeParagraph
    .Font.Underline = wdUnderlineSingle
    .Font.Bold = True
    .Range.HighlightColorIndex = wdTurquoise
    .TypeText Text:="Les équipes suivantes sont forfaits (amendes = " & rec2.Fields(7) & "€ par équipe):"
    .ParagraphFormat.SpaceBefore = 1
    .ParagraphFormat.SpaceBeforeAuto = False
    .ParagraphFormat.SpaceAfter = 1
    .ParagraphFormat.SpaceAfterAuto = False
    .Font.Reset
    .Range.HighlightColorIndex = wdNoHighlight
End With
 
Do Until rec2.EOF = True
 
With WordObj.Selection
    .TypeParagraph
    .ParagraphFormat.SpaceBefore = 0
    .ParagraphFormat.SpaceBeforeAuto = False
    .ParagraphFormat.SpaceAfter = 0
    .ParagraphFormat.SpaceAfterAuto = False
    .TypeText Text:=rec2.Fields(1) & ":" & rec2.Fields(2) & "-" & "Poule : " & rec2.Fields(3) & " " & rec2.Fields(4)
End With
 
rec2.MoveNext
Loop
 
'Sauvegarde du document et libération des fichiers
WordObj.ActiveDocument.SaveAs strCheminAccesExportExcelGB & "\Amendes coupe festival U13 et J-Mercier.doc"
WordObj.ActiveDocument.Close
 
WordObj.Quit
rec1.Close
Set rec1 = Nothing
 
rec2.Close
Set rec2 = Nothing

et en pièce jointe le résultat
Je vous remercie beaucoup pour votre aide
Bien cordialement
Georges

[marot_r]

Bonjour.

J'essayerai :

Code :

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

1
2
3
4
    .Shading.BackgroundPatternColor = -603914241
'    .TypeParagraph
'    .TypeParagraph
End With

Je ne vois pas ce que ces 2 lignes apportent.

Sinon, prend ta portion de code et copie là dans un Word.
Exécute là directement là et vois si tu as le problème.
Si tu n'as pas de problème c'est que c'est la communication entre Access et Word qui pose un problème, essaye de faire exécuter la macro dans Word par Word.
L'instruction est probablement

Code :

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

WordObj.Run "NomProcedure"

A+

[GGN44]

Bonjour,
Merci beaucoup pour cette réponse, que je vais mettre en pratique. Ne sachant pas trop comment faire j'avais créé une macro dans Word, j'ai récupéré le code que j'ai ensuite réadapté à mon module. Par contre je ne l'ai pas fait dans l'autre sens pour voir si effectivement il pouvait y avoir un problème de communication entre Word 2010 et Access 2010.

Je vais faire des tests aujourd'hui, je donnerai le résultat

Bien cordialement

[GGN44]

Bonjour,

J'ai testé le code en le mettant dans une macro word sans succès. Du coup en cherchant et en utilisant le mail que j'ai reçu j'ai changé mon fusil d'épaule, j'ai d'abord créé un tableau dans lequel j'ai pu mettre le titre et la trame de fond comme je le souhaitais, puis je suis sorti du tableau pour continuer le texte. Ce n'est sûrement pas la solution idoine, mais elle fonctionne. J'ai fait plusieurs tests sans problème. voici le 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
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
Dim myDoc As Document
Dim myWord As Word.Application
 
Set myWord = New Word.Application
 
Dim rec1 As Recordset
Dim rec2 As Recordset
 
'Lecture premier fichier
Set rec1 = CurrentDb.OpenRecordset("RequêtePlateauxT1_HG_Amendes_D", dbOpenSnapshot)
 
With myWord
'Ecriture des 2 premieres lignes avec fond jaune
    .Visible = True
    .Documents.Add
    .Selection.Tables.Add Range:=myWord.Selection.Range, NumRows:=1, NumColumns:=1
    .Selection.Font.Name = "Times New Roman"
    .Selection.Font.Size = 18
    .Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
    .Selection.Shading.Texture = wdTextureNone
    .Selection.Shading.ForegroundPatternColor = wdColorAutomatic
    .Selection.Shading.BackgroundPatternColor = wdColorYellow
    .Selection.TypeText Text:="1er TOUR COUPE FESTIVAL U13 ET J.MERCIER"
    .Selection.TypeParagraph
    .Selection.TypeText Text:=Format(rec1.Fields(0), "dddd d mmmm yyyy")
    .Selection.Font.Name = "Times New Roman"
    .Selection.Font.Size = 18
    .Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
    .Selection.Shading.Texture = wdTextureNone
    .Selection.Shading.ForegroundPatternColor = wdColorAutomatic
    .Selection.Shading.BackgroundPatternColor = RGB(255, 255, 204)
End With
 
myWord.Selection.EndKey Unit:=wdStory
 
With myWord
   .Selection.TypeParagraph
   .Selection.Font.Name = "Times New Roman"
   .Selection.Font.Size = 10
   .Selection.ParagraphFormat.Alignment = 0
   .Selection.ParagraphFormat.Shading.BackgroundPatternColor = RGB(255, 255, 255)
   .Selection.Font.Underline = wdUnderlineSingle
   .Selection.Font.Bold = True
   .Selection.Range.HighlightColorIndex = wdTurquoise
   .Selection.TypeText Text:="Rappel : Article - 160  Nombre de joueurs Mutation"
   .Selection.TypeParagraph
   .Selection.Font.Reset
   .Selection.Range.HighlightColorIndex = wdNoHighlight
   .Selection.TypeText Text:="1. Dans toutes les compétitions officielles et pour toutes les catégories d’âge, le nombre de joueurs titulaires d’une licence  Mutation  pouvant être inscrits sur la feuille de match est limité à six dont deux maximum ayant changé de club hors période normale au sens de l’article 92.1 des présents règlements."
   .Selection.TypeParagraph
   .Selection.Font.Color = wdColorRed
   .Selection.Font.Bold = True
   .Selection.Range.HighlightColorIndex = wdYellow
   .Selection.TypeText Text:="Toutefois, pour les pratiques à effectif réduit, le nombre de joueurs titulaires d’une licence Mutation pouvant être inscrits sur la feuille de match est limité à quatre dont deux maximum ayant changé de club hors période normale au sens de l’article 92.1 des présents règlements."
   .Selection.TypeParagraph
   .Selection.Font.Color = wdColorBlack
   .Selection.Font.Bold = False
   .Selection.Range.HighlightColorIndex = wdNoHighlight
   .Selection.TypeText Text:="2. Le nombre de joueurs titulaires d’une licence ayant changé de club hors période normale au sens de l’article 92.1 des présents règlements pouvant être inscrits sur la feuille de match peut être diminué ou augmenté dans les conditions fixées par les articles 45 et 47 du Statut de l’Arbitrage et 164 des présents règlements. En tout état de cause, quel que soit le nombre de joueurs mutés accordé, le nombre de joueurs titulaires d’une licence  Mutation ayant changé de club hors période normale inscrits sur la feuille de match est limité à deux maximum."
End With
 
 
'Ecriture des équipes disqualifiées
 
With myWord
    .Selection.TypeParagraph
    .Selection.Font.Underline = wdUnderlineSingle
    .Selection.Font.Bold = True
    .Selection.Range.HighlightColorIndex = wdTurquoise
    .Selection.TypeParagraph
    .Selection.TypeText Text:="Les équipes suivantes sont disqualifiées (amendes = " & rec1.Fields(7) & "€  par équipe):"
    .Selection.ParagraphFormat.SpaceBefore = 0
    .Selection.ParagraphFormat.SpaceBeforeAuto = False
    .Selection.ParagraphFormat.SpaceAfter = 0
    .Selection.ParagraphFormat.SpaceAfterAuto = False
    .Selection.Font.Reset
    .Selection.Range.HighlightColorIndex = wdNoHighlight
End With
Do Until rec1.EOF = True
 
With myWord
    .Selection.TypeParagraph
    .Selection.ParagraphFormat.SpaceBefore = 0
    .Selection.ParagraphFormat.SpaceBeforeAuto = False
    .Selection.ParagraphFormat.SpaceAfter = 0
    .Selection.ParagraphFormat.SpaceAfterAuto = False
    .Selection.TypeText Text:=rec1.Fields(1) & ":" & rec1.Fields(2) & "-" & "Poule : " & rec1.Fields(3) & " " & rec1.Fields(4) & " Motif : " & rec1.Fields(6)
End With
 
rec1.MoveNext
Loop
 
'Lecture du 2eme fichier
Set rec2 = CurrentDb.OpenRecordset("RequêtePlateauxT1_HG_Amendes_F", dbOpenSnapshot)
 
'Ecriture des équipes forfaits
With myWord
    .Selection.TypeParagraph
    .Selection.TypeParagraph
    .Selection.Font.Underline = wdUnderlineSingle
    .Selection.Font.Bold = True
    .Selection.Range.HighlightColorIndex = wdTurquoise
    .Selection.TypeText Text:="Les équipes suivantes sont forfaits (amendes = " & rec2.Fields(7) & "€ par équipe):"
    .Selection.ParagraphFormat.SpaceBefore = 1
    .Selection.ParagraphFormat.SpaceBeforeAuto = False
    .Selection.ParagraphFormat.SpaceAfter = 1
    .Selection.ParagraphFormat.SpaceAfterAuto = False
    .Selection.Font.Reset
    .Selection.Range.HighlightColorIndex = wdNoHighlight
End With
 
Do Until rec2.EOF = True
 
With myWord
    .Selection.TypeParagraph
    .Selection.ParagraphFormat.SpaceBefore = 0
    .Selection.ParagraphFormat.SpaceBeforeAuto = False
    .Selection.ParagraphFormat.SpaceAfter = 0
    .Selection.ParagraphFormat.SpaceAfterAuto = False
    .Selection.TypeText Text:=rec2.Fields(1) & ":" & rec2.Fields(2) & "-" & "Poule : " & rec2.Fields(3) & " " & rec2.Fields(4)
End With
 
rec2.MoveNext
Loop
 
'Sauvegarde du document et libération des fichiers
myWord.ActiveDocument.SaveAs strCheminAccesExportExcelGB & "\Amendes coupe festival U13 et J-Mercier.doc"
myWord.ActiveDocument.Close
 
myWord.Quit
rec1.Close
Set rec1 = Nothing
 
rec2.Close
Set rec2 = Nothing

Merci beaucoup à l'aide que j'ai eu

Cordialement
Georges

[marot_r]

Pour les balises de code, il faut sélectionner le texte concerné puis appuyer sur le #.
Elles doivent encadrer le code.

Pour l'exemple j'ai remplacé les crochets par des accolades.

Code :

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

1
2
3
{Code}
Ici du code
{/code}

A+