XL 2013 Code VBA simplifié pour bordures de tableau

Chrystel01 · 20 Avril 2021

Bonjour,

J'ai enregistré une macro automatiquement pour générer les bordures d'un tableau.
Le code généré automatiquement me semble très long et j'aimerais le simplifier car il est destiné à être intégré dans une macro plus longue.
La dernière ligne est mouvante en fonction du nb de lignes qui seront intégrées dans le tableau (je devrais pouvoi arriver à gérer ce point).

Pourriez-vous m'aider svp ?

Je vous remercie ppur votre aide et vous souhaite une bonne semaine.

Chrystel

Phil69970 · 21 Avril 2021

Re

Staple ==> oui pour K.B.

@Chrystel01

Je te propose :

VB:

Sub MAJ_Bordure_V3()
Application.ScreenUpdating = False
Dim Derlig&
Dim MaZoneRange1 As Range, MaZoneRange2 As Range

With Worksheets("TAB_RECAP")
    Derlig = .Range("A" & Rows.Count).End(xlUp).Row
    Set MaZoneRange1 = Union(.Range("A5:O" & Derlig), .Range("P5:Y" & Derlig), .Range("Z5:AK" & Derlig), .Range("AL5:AV" & Derlig))
    Set MaZoneRange2 = Union(.Range("O5:O" & Derlig), .Range("Y5:Y" & Derlig), .Range("AK5:AK" & Derlig), .Range("AV5:AV" & Derlig))
End With

With MaZoneRange1
    .Borders(xlEdgeLeft).LineStyle = 1                              '7
    .Borders(xlEdgeTop).LineStyle = 1                               '8
    .Borders(xlEdgeBottom).LineStyle = 1...

Staple1600 · 20 Avril 2021

Re

=>Phil
Oui me suis amusé avec border et frontier
Le confinement produit des effets délétères sur ma psychée.
Mais quand même grande artiste que Kate B. non ?

Chrystel01 · 20 Avril 2021

Re.,

J'aurais une question complémentaire SVP
La dernière ligne du tableau est mouvante. J'ai donc créé une variable "Derlig" correspodant à la denrière ligne du tableau.
Je l'utilise ensuite dans le code suivant
With Range("A5:O" & DerLig, "P5:Y" & DerLig, "Z5:AK" & DerLig, "AL5:AV" & DerLig)
Mais ce dernier ne fonctionne qu'avec les 2 premières zones.
Quand je rajoute les zones démarrant en Z5 et AL5 j'ai un message d'erreur.

Sauriez-vous svp comment corriger ?
Merci d'avance !

mapomme · 20 Avril 2021

Re,

Essayez :

VB:

Range("A5:O" & derlig & ",P5:Y" & derlig & ",Z5:AK" & derlig & ",AL5:AV" & derlig).Select

ou plus rigolo :

VB:

Range(Replace("A5:O*,P5:Y*,Z5:AK*,AL5:AV*", "*", derlig)).Select

Vos virgules doivent faire partie du texte final définissant le range.

Ou encore (uniquement parce que la plage résultante est une plage unique):

VB:

Range("A5:AV5").Resize(derlig - 5 + 1).Select

ou

VB:

Range(Cells(5, "a"), Cells(derlig, "av")).Select

ou

VB:

Range(Range("A5"), Range("AV" & derlig)).Select

Staple1600 · 21 Avril 2021

Re

[>Avant le dodo]
=>mapomme
Quid de mapomme_bis?
voir message#14 et sa question

mapomme · 21 Avril 2021

Staple1600 à dit:
voir message#14 et sa question

@Staple1600 ,

Oui mais il me semble que chacune des 4 zones n'est point entourée d'un cadre plus épais, non ?

Je n'attends pas ta réponse, je vais me coucher

Phil69970 · 21 Avril 2021

Re

Staple ==> oui pour K.B.

@Chrystel01

Je te propose :

VB:

Sub MAJ_Bordure_V3()
Application.ScreenUpdating = False
Dim Derlig&
Dim MaZoneRange1 As Range, MaZoneRange2 As Range

With Worksheets("TAB_RECAP")
    Derlig = .Range("A" & Rows.Count).End(xlUp).Row
    Set MaZoneRange1 = Union(.Range("A5:O" & Derlig), .Range("P5:Y" & Derlig), .Range("Z5:AK" & Derlig), .Range("AL5:AV" & Derlig))
    Set MaZoneRange2 = Union(.Range("O5:O" & Derlig), .Range("Y5:Y" & Derlig), .Range("AK5:AK" & Derlig), .Range("AV5:AV" & Derlig))
End With

With MaZoneRange1
    .Borders(xlEdgeLeft).LineStyle = 1                              '7
    .Borders(xlEdgeTop).LineStyle = 1                               '8
    .Borders(xlEdgeBottom).LineStyle = 1                            '9
    .Borders(xlEdgeRight).LineStyle = 1                             '10
    .Borders(xlInsideVertical).LineStyle = 1                        '11
    MaZoneRange2.Borders(xlEdgeRight).LineStyle = 7                 '10
    Range("A5:AV" & Derlig).Borders(xlEdgeTop).LineStyle = 7        '8
    Range("A5:AV" & Derlig).Borders(xlEdgeBottom).LineStyle = 7     '9
End With

Set MaZoneRange1 = Nothing
Set MaZoneRange2 = Nothing

End Sub

@Phil69970

eriiic · 21 Avril 2021

Bonjour à tous,

On peut même le faire sous forme de fonction pour le faire de façon réduite à plusieurs endroits :

VB:

Sub test()
    Dim b As Long, ar As Range
    ' test 1 : plage nommée
    b = bordures(Range("pltest")) 'ok si feuille non active
    ' test 2 : liste de plages
    b = bordures(Range("B2:F4,B6:F9"))
End Sub

Function bordures(plage As Range, Optional contour As Long = xlMedium)
    With plage
'        .Borders.Weight = xlThin ' tout
        .Borders(xlInsideVertical).Weight = xlThin ' seulement verticales
        .BorderAround LineStyle:=xlContinuous, ColorIndex:=xlAutomatic, Weight:=contour
    End With
End Function

Comme on ne touche pas aux valeurs, vba n'a pas l'air gêné que ce ne soit pas un usage normal d'une fonction.
En 2 lignes et on peut choisir la couleur du contour
eric

Chrystel01 · 21 Avril 2021

Bonjour à tous,

Je vous remercie pour vos retours qui répondent tous parfaitement à mon besoin.
Un grand merci pour votre réactivité et les différentes options que vous me proposez qui me permettent de découvrir l'étendue des possibilités offertes par vba.
Vos astuces me seront très utiles aussi pour d'autres fichiers.
Je vous souhaite une excellente semaine.

Staple1600 · 21 Avril 2021

mapomme à dit:
@Staple1600 ,

Oui mais il me semble que chacune des 4 zones n'est point entourée d'un cadre plus épais, non ?

Je n'attends pas ta réponse, je vais me coucher

[apres le dodo, avec du gras dedans]

VB:

Sub MAJ_Bordure_mapomme_ter()
Dim xArea As Range
   Application.ScreenUpdating = False
   For Each xArea In Range("A5:O11,P5:Y11,Z5:AK11,AL5:AV11").Areas
       xArea.BorderAround xlContinuous, xlMedium
       xArea.Borders(xlInsideHorizontal).LineStyle = xlLineStyleNone
       xArea.Borders(xlInsideVertical).Weight = xlThin
   Next xArea
End Sub

Je viens tester sur Excel 2003
Le résultat est identique qu'avec ton code initial, non ?

Bon appétit à tous

Staple1600 · 21 Avril 2021

Bonjour

Je n'avais pas vu la réponse d'eriiic au sortir de mon dodo avant de border dans le round
Donc en guise de pénitence, je rajoute de l'intellisense

VB:

Function bordures(plage As Range, Optional contour As XlBorderWeight = xlMedium)
    With plage
'        .Borders.Weight = xlThin ' tout
        .Borders(xlInsideVertical).Weight = xlThin ' seulement verticales
        .BorderAround LineStyle:=xlContinuous, ColorIndex:=xlAutomatic, Weight:=contour
    End With
End Function

eriiic · 21 Avril 2021

Bonjour Staple,

Au début je me suis dit c'est intéressant.
Mais ça ajoute quoi au juste ? En testant on n'est pas guidé à la saisie, et on peut mettre n'importe quoi sans être contredit.
Par exemple Optional contour As XlBorderWeight = xlStockOHLC
on n'a l'erreur qu'à l'exécution de .BorderAround

Il n'y a aucun contrôle supplémentaire, ça fait juste une auto-documentation du code et pas d'intellisense ou c'est ma version ?
eric

Staple1600 · 21 Avril 2021

Re

=>eriiiic
1) C'était pour avoir une pénitence agréable (puisque dans VBE)
2) Chez moi, je n'ai que les 4 choix qui s'affiche

NB: Personnellement, je ne borde que mon lit car comme souvent ici je l'écris j'assimlile les bordures à des cochoncetès ou autres fioritures.
Cela enserre mes Cellules et elles respirent mal.

eriiic · 21 Avril 2021

Ah, c'est en écrivant l'appel de la fonction !
Je pensais que c'était lors de l'écriture du code.
Je reviens donc à : c'est intéressant
eric

Staple1600 · 21 Avril 2021

Re

Oui, cela peut être intéressant pour les XLDnautes borderline
(et cela évite les effets secondaires des petites pilules de chez Fister et cie)

NB: Normalement, ...la tentative d'humour est manisfeste, donc je n'en dis pas plus

XL 2013 Code VBA simplifié pour bordures de tableau

Chrystel01

XLDnaute Occasionnel

Pièces jointes

Phil69970

Staple1600

XLDnaute Barbatruc

Chrystel01

XLDnaute Occasionnel

mapomme

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

mapomme

XLDnaute Barbatruc

Phil69970

XLDnaute Barbatruc

eriiic

XLDnaute Barbatruc

Chrystel01

XLDnaute Occasionnel

Staple1600

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

eriiic

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

eriiic

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

Discussions similaires