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
Call MISE_EN_FORME(,,,,, "J8:L" & n - 2 & ",O8:O" & n - 2)
Option Explicit Public 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 Dim colonne As Long Dim gauche As Integer, haut As Integer, bas As Integer, droit As Integer, int_vertical As Integer, int_horizontal As Integer '---------------- With ActiveSheet.Cells.Font .Name = "Cambria" .Size = 12 End With With ActiveSheet.Cells .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter 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) traiter.MergeCells = True 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) couleurs traiter, RGB(204, 0, 255), RGB(204, 192, 218) End If '--------- If Not IsMissing(Gris) Then Set traiter = Range(Gris) 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 ActiveWindow.ScrollRow = 1 'Pour placer les ascenseurs en haut ActiveWindow.ScrollColumn = 1 'Pour placer les ascenseurs à gauche '------------- 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 Public 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(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 Public 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
With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With .... 'puis ... With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlMedium End With
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre questionSub Demo() Dim maplage As Range Set maplage = Selection With maplage With .Borders .Weight = xlThin 's'applique à toute les bordures intérieur et extérieur End With .BorderAround , xlThick 's'applique seulement au bordures de contour End With End Sub
- 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.