Voilà en tout cas ce que fait ton code, écrit autrement (en évitant redondances, tant de code que d'actions) :
Private Sub CommandButton1_Click()
Range("E4") = "TESTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT"
Call MISE_EN_FORME("B2:E10", "B2:E2", "B3,C3,D3,E3", "B2,B3,C3,D3,E3", "B2", , "B4:E4")
End Sub
Private Sub MISE_EN_FORME(Optional Tableau As Variant, Optional Fusion As Variant, Optional Bordure As Variant, Optional Gras As Variant, Optional Violet As Variant, Optional Gris As Variant, Optional Vert As Variant, Optional Orange As Variant)
Dim traiter As Range, colonne As Long
Dim gauche As Integer, haut As Integer, bas As Integer, droit As Integer, int_vertical As Integer, int_horizontal As Integer
Application.ScreenUpdating = False
'----------------
With ActiveSheet.Cells.Font
.Name = "Cambria"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontMajor
End With
With ActiveSheet.Cells
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
End With
'-----------------
If Not IsMissing(Tableau) Then
Set traiter = Range(Tableau)
With traiter
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
End With
gauche xlMedium: haut xlMedium: bas = xlMedium: droit = xlMedium
int_vertical xlThin: int_horizontal xlThin
bordures traiter, gauche, haut, bas, droit, int_vertical, int_horizontal
End If
'-------------
If Not IsMissing(Fusion) Then
Set traiter = Range(Fusion)
With traiter
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
End If
'------------
If Not IsMissing(Bordure) Then
Set traiter = Range(Bordure)
With traiter
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
End With
gauche xlMedium: haut xlMedium: bas = xlMedium: droit = xlMedium
int_vertical xlNone: int_horizontal xlNone
bordures traiter, gauche, haut, bas, droit
End If
'------------
If Not IsMissing(Gras) Then
Set traiter = Range(Gras)
traiter.Font.Bold = True
End If
'----------
If Not IsMissing(Violet) Then
Set traiter = Range(Violet)
traiter.Font.Bold = True
couleurs traiter, RGB(204, 0, 255), RGB(204, 192, 218)
End If
'---------
If Not IsMissing(Gris) Then
Set traiter = Range(Gris)
traiter.Font.Bold = True
couleurs traiter, RGB(165, 165, 165), RGB(216, 216, 216)
End If
'---------
If Not IsMissing(Vert) Then
Set traiter = Range(Vert)
couleurs traiter, RGB(0, 176, 80), RGB(146, 208, 80)
End If
'---------
If Not IsMissing(Orange) Then
Set traiter = Range(Orange)
couleurs traiter, RGB(255, 192, 0), RGB(252, 213, 180)
End If
'---------
'---------
Rows("1:1").Select 'Réglage de la hauteur
Range(Selection, Selection.End(xlDown)).RowHeight = 16
colonne = Cells.Find("*", , , , xlByColumns, xlPrevious).Column 'Compte le nombre de colonnes dynamiques
Range("A:A," & Nombre_en_Lettre(colonne + 1) & ":" & Nombre_en_Lettre(colonne + 1)).ColumnWidth = 2 'Réglage de la largeur
Columns("A:" & Nombre_en_Lettre(colonne)).EntireColumn.AutoFit 'Ajuste la largeur au contenu
Range("A1:" & Nombre_en_Lettre(colonne + 1) & "1").Select 'Pour régler le zoom de la page pour que sa rentre complètement
ActiveWindow.Zoom = True
Range("A1:A1").Select 'Pour se replacer de manière propre sur la feuille
'-------------
Application.ScreenUpdating = True
Set traiter = Nothing
End Sub
Function Nombre_en_Lettre(Nombre As Long) As String
If Nombre > 0 And Nombre < 257 Then
Nombre_en_Lettre = Split(Cells(Nombre).Address, "$")(1)
Else
Nombre_en_Lettre = Error(9)
End If
End Function
Private Sub bordures(traiter As Range, gauche As Integer, haut As Integer, bas As Integer, droit As Integer, Optional int_vertical As Integer, Optional int_horizontal As Integer)
With traiter
.Borders.LineStyle = xlContinuous
.Borders.ColorIndex = 0
.Borders.TintAndShade = 0
.Borders(xlEdgeLeft).Weight = gauche
.Borders(xlEdgeTop).Weight = haut
.Borders(xlEdgeBottom).Weight = bas
.Borders(xlEdgeRight).Weight = droit
On Error Resume Next
.Borders(xlInsideVertical).Weight = int_vertical
.Borders(xlInsideHorizontal).Weight = int_horizontal
On Error GoTo 0
End With
End Sub
Private Sub couleurs(traiter As Range, couleur1 As Long, couleur2 As Long)
With traiter.Interior
.Pattern = xlPatternRectangularGradient
.Gradient.RectangleLeft = 0.5
.Gradient.RectangleRight = 0.5
.Gradient.RectangleTop = 0.5
.Gradient.RectangleBottom = 0.5
.Gradient.ColorStops.Clear
End With
With traiter.Interior.Gradient.ColorStops.Add(0)
.Color = couleur1
End With
With traiter.Interior.Gradient.ColorStops.Add(1)
.Color = couleur2
End With
End Sub
Observe également :
- plus un seul Goto là-dedans
- je ne passe pas des Ranges en paramètres, mais uniquement des chaînes les représentant. Cela me permet de gérer des erreurs aux ismissing éventuels
- cela ne veut pas dire que j'approuve
- il est fort vraisemblable que tu pourrais t'y prendre autrement qu'ainsi, mais là ... c'est toute ton appli, qu'il faudrait connaître.
________________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement vous dire ce qu'elle contient. Je n'interviendrai qu'en cas de nécessité de développ