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