Discussion :

[Invité]

Bonjour,

La mise en forme d'un tableau devient fastidieuse et sans intérêt si elle est répétitive. Je vous propose un outil pour mettre en place des bordures rapidement dans un tableau. Ce code a déjà été mis dans une de mes réponses à un message.

Le principe est de définir :
-L'aire à "border".
-Les styles de bordures extérieures et intérieures.
-Une seule couleur de bordure avec les paramètres RGB.

Nb : L'outil ne définit pas les bordures en diagonale.

Le fichier joint contient les macros suivantes pour créer les bordures :

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
Sub CreerLesBordures()
 
Dim LigneDeTitre As Long
Dim DerniereLigne As Long
Dim DerniereColonne As Long
Dim AireATraiter As Range
Dim CouleurBordure As Variant
 
    With Sheets("Données")
 
         LigneDeTitre = 10
         DerniereColonne = .Cells(LigneDeTitre, .Columns.Count).End(xlToLeft).Column
         DerniereLigne = .Cells(.Rows.Count, 1).End(xlUp).Row
         Set AireATraiter = .Range(.Cells(LigneDeTitre, 1), .Cells(DerniereLigne, DerniereColonne))
 
         Select Case .Range("CouleurChoisie")
                Case "Marron"
                     CouleurBordure = Array(247, 150, 70)
                Case "Grise"
                     CouleurBordure = Array(191, 191, 191)
                Case "Noire"
                     CouleurBordure = Array(0, 0, 0)
         End Select
 
         FormaterLesBordures AireATraiter, xlThin, xlHairline, CouleurBordure, True
         ' TypeDeTrait : très fin : xlHairline ou 1, fin : xlThin ou 2, moyen : xlMedium ou -4138, épais : xlThick ou 4
 
         Set AireATraiter = Nothing
 
    End With
 
End Sub
 
 
Sub FormaterLesBordures(ByVal AireABorder As Range, ByVal TypeDeTraitExterieur As Variant, ByVal TypeDeTraitInterieur As Variant, ByVal CouleurTrait As Variant, ByVal AvecLigneTitre As Boolean)
 
        With AireABorder
 
             ' Effacement des anciennes bordures
             .Borders.LineStyle = xlNone
 
             With .Borders(xlEdgeTop)
                  .Weight = TypeDeTraitExterieur
                  .Color = RGB(CouleurTrait(0), CouleurTrait(1), CouleurTrait(2))
             End With
 
             With .Borders(xlEdgeBottom)
                  .Weight = TypeDeTraitExterieur
                  .Color = RGB(CouleurTrait(0), CouleurTrait(1), CouleurTrait(2))
             End With
 
             With .Borders(xlEdgeLeft)
                  .Weight = TypeDeTraitExterieur
                  .Color = RGB(CouleurTrait(0), CouleurTrait(1), CouleurTrait(2))
             End With
 
             With .Borders(xlEdgeRight)
                  .Weight = TypeDeTraitExterieur
                  .Color = RGB(CouleurTrait(0), CouleurTrait(1), CouleurTrait(2))
             End With
 
             If AireABorder.Rows.Count > 1 Then
                With .Borders(xlInsideHorizontal)
                     .Weight = TypeDeTraitInterieur
                     .Color = RGB(CouleurTrait(0), CouleurTrait(1), CouleurTrait(2))
                End With
             End If
 
             If AireABorder.Columns.Count > 1 Then
                With .Borders(xlInsideVertical)
                     .Weight = TypeDeTraitInterieur
                     .Color = RGB(CouleurTrait(0), CouleurTrait(1), CouleurTrait(2))
                End With
             End If
 
             If AvecLigneTitre = True Then
                With AireABorder.Rows(1).Borders(xlEdgeBottom)
                     .Weight = TypeDeTraitExterieur
                     .Color = RGB(CouleurTrait(0), CouleurTrait(1), CouleurTrait(2))
                End With
             End If
 
      End With
 
End Sub

Nb : Sachant qu'on formate souvent de la même manière les tableaux, la couleur peut-être codée en dur dans la macro et le select case peut-être supprimé.

Et celle-ci pour effacer :

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
Sub EffacerLesBordures()
 
Dim LigneDeTitre As Long
Dim DerniereLigne As Long
Dim DerniereColonne As Long
Dim AireATraiter As Range
 
    With Sheets("Données")
 
         LigneDeTitre = 10
         DerniereColonne = .Cells(LigneDeTitre, .Columns.Count).End(xlToLeft).Column
         DerniereLigne = .Cells(.Rows.Count, 1).End(xlUp).Row
         Set AireATraiter = .Range(.Cells(LigneDeTitre, 1), .Cells(DerniereLigne, DerniereColonne))
 
         AireATraiter.Borders.LineStyle = xlNone
 
         Set AireATraiter = Nothing
 
    End With
 
 
End Sub

Pour choisir les couleurs RGB
Pièce jointe 169020


Cordialement.

[78chris]

Bonjour

Petit outil bien pratique. Merci Eric.

Rappelons aussi néanmoins que, pour les listes de données, la mise sous forme de tableau est conseillée, qu'elle offre des styles nombreux et que l'on peux en créer de personnalisés.

Bon dimanche.

[Philippe Tulliez]

Bonjour Eric,
Petite procédure bien sympathique.
J'ai réalisé il y a peu une procédure de création de planning où j'ai aussi placé des bordures et si je puis me permettre, tu pourrais remplacer les lignes 42 à 60 de la procédure FormaterLesBordures par cette boucle.

Code :

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

1
2
3
4
5
6
For b = 7 To 10
  With .Borders(b)
  .Weight = TypeDeTraitExterieur
  .Color = RGB(CouleurTrait(0), CouleurTrait(1), CouleurTrait(2))
  End With
Next

[Invité]

Bonjour Chris et Philippe,

Merci pour vos messages.

Pour Chris : Tu as raison, l’utilisation des styles est plus efficace que de coder des bordures. Je suis resté sur cette méthode car je l’utilise depuis de nombreuses années dans mes applications.

Pour Philippe : Ta proposition est plus simple que celle que je propose. J’ai ajouté la partie de code pour les bordures intérieures afin de correspondre à ma macro initiale.

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
Sub FormaterLesBordures(ByVal AireABorder As Range, ByVal TypeDeTraitExterieur As Variant, ByVal TypeDeTraitInterieur As Variant, ByVal CouleurTrait As Variant, ByVal AvecLigneTitre As Boolean)
 
Dim B As Integer
 
    With AireABorder
 
        For B = 1 To 4
          With .Borders(B)
          .Weight = TypeDeTraitInterieur
          .Color = RGB(CouleurTrait(0), CouleurTrait(1), CouleurTrait(2))
          End With
        Next
 
        For B = 7 To 10
          With .Borders(B)
          .Weight = TypeDeTraitExterieur
          .Color = RGB(CouleurTrait(0), CouleurTrait(1), CouleurTrait(2))
          End With
        Next
 
   End With
 
End Sub

Cordialement.