Instructions VBA pour mise en forme de cellules

Horusbk

XLDnaute Junior
Bonjour,

Je souhaite appliquer une mise en forme sur plusieurs cellules afin d'avoir des bordures noires, centrer le texte et l'aligner au milieu de la cellule.
J'ai donc utilisé l'enregistreur de macro pour obtenir un début de codage et je trouve que le résultat est imposant. Y a-t-il un moyen de le rendre plus compact ?

VB:
Sub Macro4()
'
' Macro4 Macro
'

'
    Range("E5:J5").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
End Sub

Merci d'avance pour votre aide :)
Baptiste
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Horusbk,
Essayer ça :
VB:
Sub MiseEnforme()
    Cellule = Array("E5", "F5", "G5", "H5", "I5", "J5")
    For i = 0 To 5
        With Range(Cellule(i))
            .Borders(xlEdgeLeft).LineStyle = xlContinuous
            .Borders(xlEdgeTop).LineStyle = xlContinuous
            .Borders(xlEdgeBottom).LineStyle = xlContinuous
            .Borders(xlEdgeRight).LineStyle = xlContinuous
            .HorizontalAlignment = xlCenter
        End With
   Next i
End Sub
S'il manque quelque chose, vous pouvez le rajouter à la suite.
 

Discussions similaires

Statistiques des forums

Discussions
312 100
Messages
2 085 290
Membres
102 851
dernier inscrit
didine501