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 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203
| Option Explicit
Dim FormatBreve As Document
Dim SecteurAbsent As Integer
Public lNomFic As String
' Tableau contenant les breves de type presse et resultats
Dim gTabBrevesPresse(99, 2) As String
Dim gTabBrevesResultats(99, 2) As String
Sub InsertPresse()
'Dim lNomFic As String
Dim lDate As Date
Dim i As Integer, j As Integer
Dim lTypeBreve As Long
Dim lPasDePresse As Boolean
Dim lPasDeResultats As Boolean
Dim cPresse As Integer, cResultats As Integer
ReDim gSumPresse(1, 1)
ReDim gSumResultats(1, 1)
lPasDePresse = True
lPasDeResultats = True
'Compte le nombre d'articles à insérer dans la compilation
lDate = gDateCompil
gPathBreve = gCustomPropertyPathBreve
If Francais() Then
gPathBreve = gPathBreve & "\FR"
Else
gPathBreve = gPathBreve & "\GB"
End If
gPathBreve = gPathBreve & "\" & Format(Year(lDate), "0000") & Format(Month(lDate), "00") & Format(Day(lDate), "00")
gPathBreve = gPathBreve & "\Presse"
lNomFic = Dir(gPathBreve & "\*doc")
'On traite un à un tous les fichiers .doc du répertoire
While Not (lNomFic = "")
Set gBreve = Application.Documents.Open(gPathBreve & "\" & lNomFic)
If ExGetCustomProperty("Breve Obligation") = "Ok" Then
lTypeBreve = CLng(ExGetCustomProperty("TypeBreve"))
If lTypeBreve = 5 Then lTypeBreve = 4
'
' 'Modification des breves ancien modele - permet la prise en compte des breves saisies sur
' 'l'ancien modele de saisie de breve (utile uniquement jusqu'au remplacement de ce modèle de saisie)
'
' 'Les données sont maintenant stockées dans des variables de doc au lieu de custom properties
' 'on cree donc ces variables et on leur affecte la valeur de la property correspondante
' If ExGetDocVariable("bSociete") = "0" Then
' Call ExSetDocVariable("bSociete", ExGetCustomProperty("Societe"))
' Call ExSetDocVariable("bTitre", ExGetCustomProperty("bTitre"))
' End If
'
' 'Le nouvelle valeur de type breve (4) correspondant à Résultat est affecté aux anciennes breves
' 'françaises commençant par " R" ou anglaises finissant par "results"
' If Left(ExGetDocVariable("bSociete"), 2) = " R" Then
' Call ExSetDocVariable("bTypeBreve", 4)
' Call ExSetDocVariable("bSociete", Mid(ExGetDocVariable("bSociete"), 12, Len(ExGetDocVariable("bSociete")) - 11))
' End If
' If Right(ExGetDocVariable("bSociete"), 7) = "results" Then
' Call ExSetDocVariable("bTypeBreve", 4)
' Call ExSetDocVariable("bSociete", Mid(ExGetDocVariable("bSociete"), 2, Len(ExGetDocVariable("bSociete")) - 8))
' End If
'Tri des breves 'presse' et 'resultats' sur la valeur de bTypeBreve
Select Case ExGetDocVariable("bTypeBreve")
Case 3
InserePresse = True
gTabBrevesPresse(cPresse, 0) = ExGetDocVariable("bSociete")
gTabBrevesPresse(cPresse, 1) = ExGetDocVariable("bTitre")
gTabBrevesPresse(cPresse, 2) = lTypeBreve
cPresse = cPresse + 1
lPasDePresse = False
Case 4
InsereResultats = True
gTabBrevesResultats(cResultats, 0) = ExGetDocVariable("bSociete")
gTabBrevesResultats(cResultats, 1) = ExGetDocVariable("bTitre")
gTabBrevesResultats(cResultats, 2) = lTypeBreve
cResultats = cResultats + 1
lPasDeResultats = False
Case Else
End Select
End If
gBreve.Close wdDoNotSaveChanges
lNomFic = Dir
Wend
Set gBreve = Nothing
CompilationBreves.Activate
Set FormatBreve = Application.Documents.Open(gPathTemplates & "\" & "Masque Presse bis")
'Tri et insertion des lus dans la presse
If lPasDePresse Then
CompilationBreves.Activate
EffaceIntervalle "TitrePresse", "FinPresse"
Else
TriABulles gTabBrevesPresse(), cPresse - 1
ReDim gSumPresse(1, cPresse)
For i = 1 To cPresse
gSumPresse(0, i) = gTabBrevesPresse(i - 1, 0)
gSumPresse(1, i) = CInt(gTabBrevesPresse(i - 1, 2))
Next i
CopyPresse gTabBrevesPresse(), cPresse - 1, "Presse"
End If
SecteurAbsent = 0
'Tri et insertion des résultats de societes
If lPasDeResultats Then
CompilationBreves.Activate
EffaceIntervalle "TitreResultats", "FinResultats"
Else
TriABulles gTabBrevesResultats(), cResultats - 1
ReDim gSumResultats(1, cResultats)
For i = 1 To cResultats
gSumResultats(0, i) = gTabBrevesResultats(i - 1, 0)
gSumResultats(1, i) = CInt(gTabBrevesResultats(i - 1, 2))
Next i
CopyPresse gTabBrevesResultats(), cResultats - 1, "Resultats"
MiseEnPage "TitreResultats", "DebutResultats" & Secteur(gTabBrevesResultats(0, 2))
End If
FormatBreve.Close wdDoNotSaveChanges
Set FormatBreve = Nothing
CompilationBreves.Activate
End Sub
Sub CopyPresse(Tableau() As String, NbItems As Integer, What As String)
Dim i As Integer
Dim PasDeRetrait As Range
For i = 0 To NbItems
If Len(Tableau(i, 0)) > 0 Then
FormatBreve.FormFields("bSociete").Result = Tableau(i, 0)
FormatBreve.Bookmarks("bTitre").Select
Selection.TypeText Text:=Tableau(i, 1)
Selection.WholeStory
Selection.Copy
CompilationBreves.Activate
'On supprime les intitules de secteurs non utilises
While Tableau(i, 2) > SecteurAbsent
EffaceIntervalle "Debut" & What & Secteur(SecteurAbsent), "Fin" & What & Secteur(SecteurAbsent)
SecteurAbsent = SecteurAbsent + 1
Wend
SecteurAbsent = Tableau(i, 2) + 1
ActiveDocument.Bookmarks("Fin" & What & Secteur(Tableau(i, 2))).Select
Selection.Paste
ActiveDocument.Bookmarks.Add Range:=Selection.Range, Name:="Fin" & What & Secteur(Tableau(i, 2))
'Si c'est la première brève
If i = 0 Then
'on la cale sur le titre partie
MiseEnPage "Titre" & What, "Fin" & What & Secteur(Tableau(i, 2))
Else
'sinon, si c'est la premiere d'un secteur
If Tableau(i, 2) > Tableau(i - 1, 2) Then
MiseEnPage "Debut" & What & Secteur(Tableau(i, 2)), "Fin" & What & Secteur(Tableau(i, 2))
End If
End If
FormatBreve.Bookmarks("bTitre").Select
Selection.SelectRow
' Selection.TypeBackspace
Selection.Delete
End If
Next i
CompilationBreves.Activate
'On supprime les intitules de secteurs non utilises et pas encore supprimes
For i = SecteurAbsent To 4
EffaceIntervalle "Debut" & What & Secteur(i), "Fin" & What & Secteur(i)
Next i
'On supprime les retraits de première ligne
Set PasDeRetrait = ActiveDocument.Range(Start:=ActiveDocument.Bookmarks("Titre" & What).Range.End, _
End:=ActiveDocument.Bookmarks("Fin" & What).Range.Start)
PasDeRetrait.ParagraphFormat.FirstLineIndent = CentimetersToPoints(0)
End Sub |
Partager