VBA Boucle pour Mise en Forme
E
Bonjour et merci d'avance!
Je souhaiterais faire une boucle pour mettre en forme mes feuilles (il y a un tableau dynamique dans chacune) dans un classeur.
voila le début de code que j'ai fais mais qui me permet pas de tous faire et qui je pense peut être optimiser mais je suis bloquer! en gros ce que je souhaite c'est suivant la condition appliquer la mise en forme (font bordure hauteur de ligne style en gras....) sur la ligne entre les colonnes B et H
Option Explicit
Sub MiseEnForme()
Dim a As Integer
Application.ScreenUpdating = False
With Cells
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
.Borders(xlEdgeLeft).LineStyle = xlNone
.Borders(xlEdgeTop).LineStyle = xlNone
.Borders(xlEdgeBottom).LineStyle = xlNone
.Borders(xlEdgeRight).LineStyle = xlNone
.Borders(xlInsideVertical).LineStyle = xlNone
.Borders(xlInsideHorizontal).LineStyle = xlNone
End With
Cells.Interior.Color = RGB(217, 217, 217)
Range("B6", "H6").Interior.Color = RGB(48, 84, 150)
For a = Cells(1048576, 2).End(xlUp).Row To 1 Step -1
If Cells(a, 3).Value > 0 Then Range(Cells(a, 2), Cells(a, 6)).Interior.Color = RGB(255, 255, 255)
Next a
For a = Cells(1048576, 2).End(xlUp).Row To 1 Step -1
If Cells(a, 2).Value > 0 Then Range(Cells(a, 2), Cells(a, 6)).Interior.Color = RGB(180, 198, 231)
Next a
For a = Cells(1048576, 2).End(xlUp).Row To 1 Step -1
If Cells(a, 2).Value > 0 Then Range(Cells(a, 2), Cells(a, 6)).Interior.Color = RGB(142, 169, 219)
Next a
For a = Cells(1048576, 2).End(xlUp).Row To 1 Step -1
If Cells(a, 1).Value = "Total général" Then Range(Cells(a, 1), Cells(a, 6)).Interior.Color = RGB(255, 255, 255)
Next a
Application.ScreenUpdating = True
End SubJ'ai tenter avec un with d'intégrer plusieurs paramètre mais ça marche pas
Option Explicit
Sub Test67()
Dim a As Integer
For a = Cells(1048576, 2).End(xlUp).Row To 1 Step -1
If Cells(a, 1).Value = "Total général" Then
With Range(Cells(a, 1), Cells(a, 6))
.Interior.Color = RGB(255, 255, 255)
.Borders(xlEdgeTop).LineStyle = xlDouble
End With
Next a
End SubInvité
Bonjour Excelium067
Voici le code optimisé, en revanche je n'ai pas compris certains tests identiques et application de 2 couleurs différentes !?
Sub MiseEnForme()
Dim dLig As Long, Lig As Long
Application.ScreenUpdating = False
With ActiveSheet
With .Cells
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
.Borders(xlEdgeLeft).LineStyle = xlNone
.Borders(xlEdgeTop).LineStyle = xlNone
.Borders(xlEdgeBottom).LineStyle = xlNone
.Borders(xlEdgeRight).LineStyle = xlNone
.Borders(xlInsideVertical).LineStyle = xlNone
.Borders(xlInsideHorizontal).LineStyle = xlNone
End With
.Cells.Interior.Color = RGB(217, 217, 217)
.Range("B6:H6").Interior.Color = RGB(48, 84, 150)
' Dernière ligne de la feuille
dLig = .Range("B" & Rows.Count).End(xlUp).Row
' Pour chaque ligne
For Lig = dLig To 1 Step -1
If .Range("A" & Lig).Value = "Total général" Then .Range("A" & Lig & ":F" & Lig).Interior.Color = RGB(255, 255, 255)
If .Range("B" & Lig).Value > 0 Then
' C'est l'un ou l'autre, mais pas les 2 !?
.Range("B" & Lig & ":F" & Lig).Interior.Color = RGB(180, 198, 231)
.Range("B" & Lig & ":F" & Lig).Interior.Color = RGB(142, 169, 219)
End If
If .Range("C" & Lig).Value > 0 Then .Range("B" & Lig & ":F" & Lig).Interior.Color = RGB(255, 255, 255)
Next Lig
End With
Application.ScreenUpdating = True
End SubA adapter je pense
@+
E
Merci pour ton code c'est exactement ce qu'il me fallait, j'ai pu l'adapter et voila le résultat!
Avant:
Après
et le code!
Option Explicit
Sub MiseEnForme()
Dim dLig As Long, Lig As Long
Application.ScreenUpdating = False
With ActiveSheet
With .Cells
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
.Borders(xlEdgeLeft).LineStyle = xlNone
.Borders(xlEdgeTop).LineStyle = xlNone
.Borders(xlEdgeBottom).LineStyle = xlNone
.Borders(xlEdgeRight).LineStyle = xlNone
.Borders(xlInsideVertical).LineStyle = xlNone
.Borders(xlInsideHorizontal).LineStyle = xlNone
End With
.Cells.Interior.Color = RGB(217, 217, 217)
.Cells.Font.Bold = False
.Cells.Font.Underline = False
.Cells.IndentLevel = 0
' Dernière ligne de la feuille
dLig = .Range("B" & Rows.Count).End(xlUp).Row
' Pour chaque ligne
For Lig = dLig To 1 Step -1
If .Range("B" & Lig).Value > 0 And .Range("B" & Lig).Value <> "Total général" Then
With .Range("B" & Lig & ":I" & Lig)
.Interior.Color = RGB(48, 84, 150)
.Font.Color = RGB(255, 255, 255)
.Font.Name = "Century Gothic"
.Font.Bold = True
.Font.Size = 12
.RowHeight = 20
.VerticalAlignment = xlCenter
End With
End If
If .Range("B" & Lig).Value = "Total général" Then
With .Range("B" & Lig & ":I" & Lig)
.Interior.Color = RGB(255, 255, 255)
.Borders(xlEdgeTop).LineStyle = xlDouble
.Borders(xlEdgeTop).Color = RGB(48, 84, 150)
.Font.Color = RGB(0, 32, 96)
.Font.Name = "Century Gothic"
.Font.Bold = True
.Font.Size = 12
.RowHeight = 20
.VerticalAlignment = xlCenter
End With
End If
If .Range("E" & Lig).Value > 0 Then
With .Range("B" & Lig & ":I" & Lig)
.Interior.Color = RGB(255, 255, 255)
.Font.Color = RGB(0, 0, 0)
.Font.Name = "Century Gothic"
.Font.Bold = False
.Font.Size = 10
.RowHeight = 15
.VerticalAlignment = xlCenter
End With
End If
If .Range("D" & Lig).Value > 0 Then
With .Range("D" & Lig)
.Interior.Color = RGB(255, 255, 255)
.Font.Color = RGB(0, 0, 0)
.Font.Name = "Century Gothic"
.Font.Bold = True
.Font.Size = 10
.Font.Underline = xlUnderlineStyleSingle
.RowHeight = 15
.VerticalAlignment = xlCenter
.HorizontalAlignment = xlLeft
End With
End If
If .Range("C" & Lig).Value > 0 Then
With .Range("B" & Lig & ":I" & Lig)
.Interior.Color = RGB(155, 194, 230)
.Font.Color = RGB(0, 32, 96)
.Font.Name = "Century Gothic"
.Font.Bold = True
.Font.Size = 10
.RowHeight = 15
.VerticalAlignment = xlCenter
End With
End If
.Range("B" & Lig).HorizontalAlignment = xlLeft
.Range("C" & Lig).HorizontalAlignment = xlLeft
.Range("D" & Lig).HorizontalAlignment = xlLeft
.Range("E" & Lig).HorizontalAlignment = xlLeft
.Range("F" & Lig).HorizontalAlignment = xlCenter
With .Range("G" & Lig)
.HorizontalAlignment = xlCenter
.NumberFormat = "0"
End With
With .Range("H" & Lig)
.HorizontalAlignment = xlRight
.InsertIndent 1
.NumberFormat = "0.000"
End With
With .Range("I" & Lig)
.HorizontalAlignment = xlLeft
.InsertIndent 1
End With
Next Lig
With .Range("B6:I6")
.Interior.Color = RGB(0, 32, 96)
.Font.Color = RGB(255, 255, 255)
.Font.Name = "Century Gothic"
.Font.Bold = True
.Font.Size = 10
.RowHeight = 30
.VerticalAlignment = xlCenter
End With
.Range("F6:I6").HorizontalAlignment = xlCenter
Rows("8:13").Select
Selection.EntireRow.Hidden = True
Range("J2").Select
End With
Application.ScreenUpdating = True
End Sub