Changer un format de tableau

[shimuno]

Bonjour

Je travaille actuellement sur une macro word permettant de compiler des articles (écrits par différents utilisateurs) dans un fichier unique.

Il existe plusieurs types d'articles, qui ont une mise en page spécifique.

Je suis en train de modifier cette macro, car la mise en page est assez datée.

Mon problème est le suivant : certains textes sont collés avec des marges différentes. Je souhaiterait donc pouvoir modifier ces marges et/ou les largeurs des tableaux.

Je ne connais pas grand grand chose à VBA, donc là je loose un peu.

Voici un extrait du code. Si vous avez des idées...

En vous remerciant.

Code :

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

[ouskel'n'or]

Bonjour Shimuno,
Tu dis

Je souhaiterais donc pouvoir modifier ces marges et/ou les largeurs des tableaux.

Quelle modification veux-tu apporter ? Si tu veux les homogénéiser, c'est assez facile, par contre, si ces marges dépendent de la cellule, ça devient tout de suite plus fastidieux.
Pour mettre toutes les marges et les indentations à zéro, tu peux tester ça

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Sub MargesAZero()
Dim Doc1 As Document
    Set Doc1 = ActiveDocument
    Doc1.Tables(1).Select
    With Selection.ParagraphFormat
        .LeftIndent = CentimetersToPoints(0)
        .RightIndent = CentimetersToPoints(0)
        .SpaceBefore = 0
        .SpaceBeforeAuto = False
        .CharacterUnitLeftIndent = 0
        .CharacterUnitRightIndent = 0
        .SpaceAfter = 0
        .FirstLineIndent = CentimetersToPoints(0)
    End With
End Sub

Tu dis
A+

[shimuno]

Après quelques recherches, j'ai trouvé là où ça déconne. Le problème vient du fait que certains tableaux sont collés avec un retrait de 1,13.

J'ai bien sur cherché 1,13 dans le projet, sans succès.

Ce qu'il faudrait peut être faire, c'est trouver l'instruction qui dit de coller le tableau qui contient le texte, le sélectionner et lui dire d'annuler le retrait. Ce qui voudrait dire de coller une instruction de ce type :

Code :

1
2
 
Selection.Tables(1).Rows.LeftIndent = CentimetersToPoints(0)

Mais je ne sais pas où.


Ce n'est qu'un fragment du code. Si vous pensez que les instructions utiles ne sont pas là, je pourrais coller d'autre truc.


PS : merci pour l'initialisation des marges, mais le document maître contient des marges importantes pour le reste du projet.

[Heureux-oli]

Le hic, c'est que tout le code ne s'y trouve pas, et la partie que tu nous mets fait 5 pages.

Je ne sais pas comment tu obtiens des tableaux, à aucun moment il n'est fait mention de table ou de cellules dans le code.

Ce qui est appelé Tableau, ce sont des données et pas des tableaux de Word.

[ouskel'n'or]

Je n'ai pas compris mais je peux te donner une indication : Le N° du tableau que tu colles est chronologique dans le document soit = à

Code :

NoTableau = ActiveDocument.Tables.count

Tu peux donc accéder à ton dernier tableau avec le code que je t'ai passé en fournissant NoTableau à

Code :

Doc1.Tables(NoTableau).Select

Tu dis
A+

[shimuno]

Okay, merci pour vos conseils. J'ai fini par trouver. Thx !