XL 2021 Encadrement de cellule sur tableau dynamique

[treza88]

Bonjour à tous,

J'ai un tableau qui ressemble au fichier joint, je voudrais trouver le meilleur moyen d'encadrer les cellules qui vont de I2 a V24.
Dans un tableau fixe, pas de soucis, mais je suis dans un tableau qui par macro augmente en longueur, comme en hauteur, et pas forcément tout le temps, des fois que la longueur ou que la hauteur ou pas du tout.

J'ai fait une macro qui rempli automatiquement toutes la zone, mais sur le fichier de travail est comporte plusieurs millier de ligne et centaine de colonnes, et ça prend un certains temps sur l’exécution de la macro complète.

Il y aurait il un moyen de le faire autrement ?

Je pensais éventuellement à une MFC, mais je ne sais pas si c'est possible.

 

[treza88]

Oui bien entendu, mais rien ne m’empêche d'envisagé la question.
Et pour la mise en forme du tableau d'origine (groupage, couleur des lignes et colonnes), il peut les respecter ?

 

[laurent950]

Donc pour l'instant je suis sur une solution macro qui a chaque copier coller dans le tableau ajoute les encadrements sur uniquement les parties qui viennent d’être collé.
Donc beaucoup moins de surface à traiter.

Sub Encadrement()

    Dim ws As Worksheet
    Dim rng As Range
    Dim b As Borders
    
    '--- Feuille cible
    Set ws = ThisWorkbook.Worksheets(ActiveSheet.Name)
    
    '--- Dernière ligne utilisée
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    '--- Dernière colonne utilisée
    lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
    
    '--- Plage bornée
    Set rng = ws.Range(ws.Cells(2, 9), ws.Cells(lastRow, lastCol))   ' 9 = colonne I
    
    '--- Test visuel
    'rng.Select
    
    '--- Bordures de la plage
    Set b = rng.Borders
    
    '--- Étape 1 : supprimer toutes les bordures
    b(xlDiagonalDown).LineStyle = xlNone
    b(xlDiagonalUp).LineStyle = xlNone
    b(xlEdgeLeft).LineStyle = xlNone
    b(xlEdgeTop).LineStyle = xlNone
    b(xlEdgeBottom).LineStyle = xlNone
    b(xlEdgeRight).LineStyle = xlNone
    b(xlInsideVertical).LineStyle = xlNone
    b(xlInsideHorizontal).LineStyle = xlNone
    
'--- Étape 1 : Recréer des bordures autour de chaque cellule
    With b
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    
''--- Étape 2 : ajouter uniquement celles que tu veux
'    With b(xlEdgeLeft)
'        .LineStyle = xlContinuous
'        .Weight = xlThin
'        .ColorIndex = xlAutomatic
'    End With
'
'    With b(xlEdgeTop)
'        .LineStyle = xlContinuous
'        .Weight = xlThin
'        .ColorIndex = xlAutomatic
'    End With
'
'    With b(xlEdgeBottom)
'        .LineStyle = xlContinuous
'        .Weight = xlThin
'        .ColorIndex = xlAutomatic
'    End With
'
'    With b(xlEdgeRight)
'        .LineStyle = xlContinuous
'        .Weight = xlThin
'        .ColorIndex = xlAutomatic
'    End With
End Sub

 

[TooFatBoy]

Oui bien entendu, mais rien ne m’empêche d'envisagé la question.

Toutafé. 😉

Et pour la mise en forme du tableau d'origine (groupage, couleur des lignes et colonnes), il peut les respecter ?

Normalement, oui.
Enfin... plus ou moins, et ce n'est pas forcément évident à mettre en place.

Au départ je ne parlais que de l'encadrement. Et ça c'est hyper simple à faire : il suffit de créer un nouveau type de TS.
Après, tu peux mélanger TS et macro : TS pour l'encadrement, macro pour le reste.

 

[Phil69970]

@laurent950

En plus court encore pour supprimer les bordures ..... 😉

Sub Encadrement()

    Dim ws As Worksheet
    Dim rng As Range
    Dim b As Borders
    
    '--- Feuille cible
    Set ws = ThisWorkbook.Worksheets(ActiveSheet.Name)
    
    '--- Dernière ligne utilisée
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    '--- Dernière colonne utilisée
    lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
    
    '--- Plage bornée
    Set rng = ws.Range(ws.Cells(2, 9), ws.Cells(lastRow, lastCol))   ' 9 = colonne I
    
    '--- Test visuel
    'rng.Select
    
    '--- Bordures de la plage
    Set b = rng.Borders
    
    '--- Étape 1 : supprimer toutes les bordures
    b.LineStyle = xlNone
    
'    b(xlDiagonalDown).LineStyle = xlNone
'    b(xlDiagonalUp).LineStyle = xlNone
'    b(xlEdgeLeft).LineStyle = xlNone
'    b(xlEdgeTop).LineStyle = xlNone
'    b(xlEdgeBottom).LineStyle = xlNone
'    b(xlEdgeRight).LineStyle = xlNone
'    b(xlInsideVertical).LineStyle = xlNone
'    b(xlInsideHorizontal).LineStyle = xlNone
    
'--- Étape 1 : Recréer des bordures autour de chaque cellule
    With b
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    
''--- Étape 2 : ajouter uniquement celles que tu veux
'    With b(xlEdgeLeft)
'        .LineStyle = xlContinuous
'        .Weight = xlThin
'        .ColorIndex = xlAutomatic
'    End With
'
'    With b(xlEdgeTop)
'        .LineStyle = xlContinuous
'        .Weight = xlThin
'        .ColorIndex = xlAutomatic
'    End With
'
'    With b(xlEdgeBottom)
'        .LineStyle = xlContinuous
'        .Weight = xlThin
'        .ColorIndex = xlAutomatic
'    End With
'
'    With b(xlEdgeRight)
'        .LineStyle = xlContinuous
'        .Weight = xlThin
'        .ColorIndex = xlAutomatic
'    End With
End Sub

 

[treza88]

Merci pour ton exemple de code laurent950 et ta simplification Phil69970.

Par contre je me pose une question sur ce code, si c'est pour une extension du tableau, quel est l’intérêt de supprimer les encadrements déjà existant ?

De mon coté je vois ça comme une opération inutile et supplémentaire, mais il y a peut être un intérêt particulier que je ne comprend pas.

 

[laurent950]

si c'est pour une extension du tableau, quel est l’intérêt de supprimer les encadrements déjà existant ?

Dans ce cas il faut passer a la méthode 2

'--- Étape 2 : ajouter uniquement celles que tu veux (sans effacer celle existante : a paramétrer en amont)
'    With b(xlEdgeLeft)
'        .LineStyle = xlContinuous
'        .Weight = xlThin
'        .ColorIndex = xlAutomatic
'    End With
'
'    With b(xlEdgeTop)
'        .LineStyle = xlContinuous
'        .Weight = xlThin
'        .ColorIndex = xlAutomatic
'    End With
'
'    With b(xlEdgeBottom)
'        .LineStyle = xlContinuous
'        .Weight = xlThin
'        .ColorIndex = xlAutomatic
'    End With
'
'    With b(xlEdgeRight)
'        .LineStyle = xlContinuous
'        .Weight = xlThin
'        .ColorIndex = xlAutomatic
'    End With

 

[Phil69970]

quel est l’intérêt de supprimer les encadrements déjà existant ?

De mon coté je vois ça comme une opération inutile et supplémentaire, mais il y a peut être un intérêt particulier que je ne comprend pas.

Pas sur du tout que cela aille plus vite de juste rajouter ce qui manque comme bordure que de tout enlever et tout remettre....