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 dune 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 larticle 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 dune 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 larticle 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 dune licence ayant changé de club hors période normale au sens de larticle 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 lArbitrage 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 dune 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 |
Partager