Discussion :

[Adiren]

Bonjour, j'ai actuellement une grande quantité de document Word qui contiennent une grande quantité de tableau. Certains d'autres eux ont besoin de rajouter des interlignes sur une ligne précise, d'autres non.

Voici un exemple :



Lorsqu'un tableau à un ligne où il y a marqué "Description", il faut rajouter un interligne de 6pt en haut et en bas sur le texte de la ligne juste en dessous.

Bien evidemment le nombre de ligne et de colonnes sur chaque tableau de ne sont pas identique mais si il y a une ligne "Description" la ligne du dessous doit avoir un interligne d'ajouter.


J'ai essayé de récupérer la bonne case à l'aide de boucle imbriqué mais cela crash lorsque 2 cellules d'une meme ligne sont fusionnés. Quelqu'un pourrait m'aider s'il vous plait ?

Merci d'avance, Adiren

Pour l'instant voici mon code, j'ai hardcoder les endroits où je change l'interligne

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
 
Sub Interligne_6()
Dim combien As Byte
Dim i As Byte
 
combien = ActiveDocument.Tables.Count
 
For i = 8 To combien
    With ActiveDocument.Tables(i).Cell(14, 1).Range.ParagraphFormat
        .LeftIndent = CentimetersToPoints(0)
        .RightIndent = CentimetersToPoints(0)
        .SpaceBefore = 6
        .SpaceAfter = 6
    End With
Next i
End Sub

[E KERGRESSE]

Bonjour,

A tester :

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
 
Option Explicit
 
Sub TestReglerLInterligne()
 
    If ActiveDocument.Tables.Count = 0 Then Exit Sub
    ReglerLInterligne 6
   ' ReglerLInterligne 0
 
End Sub
 
Sub ReglerLInterligne(ByVal ValeurInterligne As Integer)
 
Dim DocenCours As Document
Dim I As Integer, J As Integer, IndexMatrice As Integer
Dim MaTable As Table
Dim MatriceTableaux() As Variant
 
 
    IndexMatrice = 0
 
    Set DocenCours = ActiveDocument
    With DocenCours
        For I = 1 To .Tables.Count
            With .Tables(I)
                 For J = 1 To .Range.Cells.Count
                     With .Range.Cells(J)
                          If InStr(1, .Range, "Description", vbTextCompare) > 0 Then
                             ReDim Preserve MatriceTableaux(1, IndexMatrice)
                             MatriceTableaux(0, IndexMatrice) = I
                             MatriceTableaux(1, IndexMatrice) = J + 1
                             IndexMatrice = IndexMatrice + 1
                          End If
                    End With
                 Next J
           End With
        Next I
 
        For IndexMatrice = LBound(MatriceTableaux, 2) To UBound(MatriceTableaux, 2)
            Set MaTable = .Tables(MatriceTableaux(0, IndexMatrice))
            MaTable.Range.Cells(MatriceTableaux(1, IndexMatrice)).Select
            Selection.ParagraphFormat.SpaceBefore = ValeurInterligne
            Selection.ParagraphFormat.SpaceAfter = ValeurInterligne
            Set MaTable = Nothing
        Next IndexMatrice
 
    End With
    Set DocenCours = Nothing
 
End Sub

[Adiren]

ça fonctionne parfaitement, j'ai bien compris comment vous l'avez fait et j'ai donc pu l'adapter a ma sauce,
Merci beaucoup !