Optimiser de code (procédure de mise en forme des données) [Résolu]
SERIEUXETCOOL336
Messages postés dimanche 3 avril 2011Date d'inscription
12 juin 2012
Dernière intervention
-
22 avril 2012 à 14:08 - Dernière réponse : SERIEUXETCOOL336
Messages postés dimanche 3 avril 2011Date d'inscription
12 juin 2012
Dernière intervention
- 26 avril 2012 à 16:40
Dans le cadre d'une de mes appli par vba je rencontre un problème d'optimisation de code. Il s'agit d'une procédure qui me permet de faire toute une mise en forme de mes données se trouvant sur une feuille Excel.
Cette procédure a été réalisée avec l'aide de l'enregistreur de macro et je ne suis pas sur d'avoir fait convenablement le ménage
Je suis convaincu que la procédure peut être améliorée de façon à s’exécuter BEAUCOUP plus rapidement qu'elle ne l'est actuellement.
Voici le code d'appel qui permet de charger un exemple sur la feuille :
Option Explicit
Public Sub TEST()
Range("E4") = "TESTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT"
Call MISE_EN_FORME(Range("B2:E10"), Range("B2:E2"), Range("B3,C3,D3,E3"), Range("B2,B3,C3,D3,E3"), Range("B2"), , Range("B4:E4"))
End Sub
Et maintenant la procédure en elle même :
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 colonne As Long
'----------------
Cells.Select
With Selection.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 Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
End With
'-----------------
'-----------------
If IsMissing(Tableau) Then
GoTo Tableau
End If
Tableau.Select
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
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
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
Tableau:
'-------------
'-------------
If IsMissing(Fusion) Then
GoTo Fusion
End If
Fusion.Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
Fusion:
'------------
'------------
If IsMissing(Bordure) Then
GoTo Bordure
End If
Bordure.Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Bordure:
'------------
'-----------
If IsMissing(Gras) Then
GoTo Gras
End If
Gras.Font.Bold = True
Gras:
'----------
'----------
If IsMissing(Violet) Then
GoTo Violet
End If
Violet.Select
With Selection.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 Selection.Interior.Gradient.ColorStops.Add(0)
.Color = RGB(204, 0, 255)
End With
With Selection.Interior.Gradient.ColorStops.Add(1)
.Color = RGB(204, 192, 218)
End With
Violet:
'---------
'----------
If IsMissing(Gris) Then
GoTo Gris
End If
Gris.Select
With Selection.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 Selection.Interior.Gradient.ColorStops.Add(0)
.Color = RGB(165, 165, 165)
End With
With Selection.Interior.Gradient.ColorStops.Add(1)
.Color = RGB(216, 216, 216)
End With
Gris:
'---------
'----------
If IsMissing(Vert) Then
GoTo Vert
End If
Vert.Select
With Selection.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 Selection.Interior.Gradient.ColorStops.Add(0)
.Color = RGB(0, 176, 80)
End With
With Selection.Interior.Gradient.ColorStops.Add(1)
.Color = RGB(146, 208, 80)
End With
Vert:
'---------
'----------
If IsMissing(Orange) Then
GoTo Orange
End If
Orange.Select
With Selection.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 Selection.Interior.Gradient.ColorStops.Add(0)
.Color = RGB(255, 192, 0)
End With
With Selection.Interior.Gradient.ColorStops.Add(1)
.Color = RGB(252, 213, 180)
End With
Orange:
'---------
'---------
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
'-------------
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
Vu la longueur de cette procédure...On doit pouvoir épurer pleinnnnnnns de choses je pense. Mais qu'est ce qui est utile et qu'est ce qui ne l'est pas ??? La méthode que j’emploie est elle bonne ?
ucfoutu18039
Messages postés lundi 7 décembre 2009Date d'inscriptionContributeurStatut
11 avril 2018
Dernière intervention -23 avril 2012 à 11:14
+3
Utile
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
Cette réponse vous a-t-elle aidé ?Merci pour votre retour.
N'oubliez pas de prendre quelques secondes pour remercier l'auteur : Merci pour votre retour.
Nous sommes désolés. Notre objectif est de vous donner la meilleure réponse possible.
Après avoir cogité un peu plus sur ce code, j'ai décidé de poster la dernière version améliorée de ce dernier. Cette version réalise les mêmes choses avec certaines lignes de code inutiles en moins et quelques modifis minimes.
D'autre part, pour ceux qui voudraient utiliser en entrée un Range qui sélectionnerait plusieurs colonnes ou lignes distinctes voici un exemple d'appel qui fonctionne. Ce n'est pas si trivial qu'il n'y parait pour les débutants. Si ça peut servir...
André
Pour appeler la procédure :
Call MISE_EN_FORME(,,,,, "J8:L" & n - 2 & ",O8:O" & n - 2)
Pour le code de la procédure :
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
Cette réponse vous a-t-elle aidé ?Merci pour votre retour.
N'oubliez pas de prendre quelques secondes pour remercier l'auteur : Merci pour votre retour.
Nous sommes désolés. Notre objectif est de vous donner la meilleure réponse possible.
ucfoutu18039
Messages postés lundi 7 décembre 2009Date d'inscriptionContributeurStatut
11 avril 2018
Dernière intervention -22 avril 2012 à 16:56
0
Utile
Bonjour,
Hé bé ! (tu es bien gourmand).
Difficile de t'aider à accroître la rapidité (sauf sur un ou deux points)
Il y a par contre beaucoup de ménage à faire !
Déjà :
Peux-tu expliquer pourquoi tu définis deux fois les bordures si tableau ?
Exemple :*
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
Pour dire deux fois la même chose, sauf pour le poids (Weight). C'est d'autant plus surprenant que, comme avec Louis XVI, le dernier à parler aura raison (xlMedium) ?
Un ménage te sera proposé après ta réponse .
________________________
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
Puisque tu vas toujours sur les mêmes cellules, pourquoi ne pas te faire une feuille-modèle avec les mises en formes constantes. Ensuite tu repasses avec juste ce quIl faut changer. Déjà, cela t'éviterait de repartir à zéro chaque fois.
Et puis, pourquoi pas une mise en forme conditionelle ? Tu as droit à quatre formats; le format de base plus 3 conditions.
Tout ce qui peut être fait directement sans VBA, c'est déjà plus rapide que VBA
Malheureusement je ne vais pas toujours sur les mêmes cellules. C'est justement le but de la procédure : Appliquer une mise en forme uniforme ou que l'on soit.
Donc les cellules changent, les feuilles aussi.
De plus, et pour répondre à ta remarque, les feuilles sont déjà créées par vba. Elles sont donc fraichement nouvelles, et j'applique ensuite la mise en forme qui me conviens par code toujours.
Cette procédure me conviens parfaitement quand la feuille contient peu de données. Mais elle est tellement mal optimisée que dès lors que la feuille contient un gros lot de données, la macro rame. On le ressens assez bien.
Je pense plus qu'il faille épurer que modifier la méthode. Je peux me tromper bien sur.
Aie aie aie ! Je suis complètement passé au travers de ta réponse Ucfoutu !!!
Dsl je ne l'avais pas vu.
Donc avec tout mon retard (je m'en excuse, c'est ma faute), je peux répondre.
Pourquoi je définis 2 fois les bordures de mon tableau ??? Et bien euuuh c'est à cause de l'enregistreur de macro qui agit de manière séquentielle (c'est son rôle en même temps ). Moi je veux que la plage sélectionnée (qui représente le tableau) aie toutes ses bordures en fines ET uniquement les bordures extérieures en plus gros.
Du coup avec l'enregistreur il me dit : Premier tableau avec toutes les bordures en fines. Puis rebelote, deuxième tableau (qui en fait est le même) toutes les bordures extérieures en gros.
Je ne suis pas parvenu à fusionner les 2 étapes en un seul step. J'obtenais une erreur car je m'y prenais mal sans doute. Donc j'avais laissé les deux étapes dissociées et mon code ne plantait pas.
Mais c'est pas fin du tout j'en conviens
Je vais quand même lister les actions qui intéressement dans la mise en forme. Dans l'ordre sa donne ceci :
-Sur toutes les cellules, Cambria, 12, Centrer, Aligner au centre (c'est la base de départ). Ça me stresse de travailler avec autre choses sinon...
-Pour Tableau c'est Toutes les bordures, puis Bordures épaisse en encadré
-Pour Fusion c'est Fusionner et centrer
-Pour Bordure c'est Bordures épaisse en encadré uniquement
-Pour Gras, c'est mettre le contenu de la cellule en gras
-Pour Violet/Gris/Vert/Orange c'est appliquer la couleur que j'ai mis avec les 2 gradients
-Et puis sur la fin c'est définir l'épaisseur des lignes, puis définir l'épaisseur de la première colonne et de la dernière. De faire en sorte que le contenu soit ajusté aux cellules.
-La dernière chose est de se replacer proprement en cellule A1
Rien que ça tu me diras^^
Si je n'ai pas été clair, je peux donner d'autres détails. Mais je pense que la mise en forme que je demande est "basique" finalement.
Bien cordialement,
André
Ps : Ucfoutu, je n'ai pas eu droit à l'ogre qui crie à tue tête "A voté !".
Ici, il était plutôt soft.
ucfoutu18039
Messages postés lundi 7 décembre 2009Date d'inscriptionContributeurStatut
11 avril 2018
Dernière intervention -22 avril 2012 à 19:48
0
Utile
Bon,
1) je dîne
2) j'écoute les résultats du vote
3) je te fais cela en beaucoup plus court et moins lent
A plus.
________________________
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
je ne viens pas remettre en question ce qui à été fait mais je viens juste amener 2 petites chose peu connues à propos des bordures.
1) les méthodes de mise en forme des bordures peuvent être appliquées directement à la collection Bordures
2) il existe une méthode spécifique pour les bordures de contour.
Donc pour une plage avec des bordures différentes autour et à l’intérieur on peu écrire:
Sub 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
ucfoutu18039
Messages postés lundi 7 décembre 2009Date d'inscriptionContributeurStatut
11 avril 2018
Dernière intervention -23 avril 2012 à 13:00
0
Utile
Bonjour, bigfish_le vrai
Tu as raison.
J'ai toutefois hésité à l'utiliser. Pourquoi ?
En raison du cas "merge", qui ne souffre aucune bordure à l'intérieur et pour lequel un premier essai avait généré une erreur. C'est même là la raison du seul on error resume next du code suggéré, y compris avec 2 paramètres optionnels.
________________________
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
Bien j'ai pu tester ton code Ucfoutu...Il est juste top !
Plus court, parfaitement reproductible et performant de plus. Bref perfect
Pour info, en cumulant ce code amélioré et le code amélioré que tu m'avais proposé pour importer les données de mon fichier texte...Je divise par 2 mon temps d’exécution global. C'est juste du bonheur.
Je peux maintenant travailler aisément avec des fichiers de 100 000 lignes*8 colonnes sans le moindre soucis.
Merci à vous deux Ucfoutu et bigfish_le vrai pour m'avoir aidé à franchir cette limite.
Post résolu
A tous, bonne soirée.
Bien cordialement,
André
Ps : Ucfoutu
- 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.
J'ai bien noté que la méthode que j'emploie n'est sans doute pas la plus appropriée. Ce qui veut également dire que l'on pourrait mieux faire en cas de besoin. Pour le moment je ne suis pas à 20 secondes prêt. Donc je suis content. Le jour ou j'aurais besoin de passer de la limite 100 000 lignes à 1 000 000 de lignes je pense que j'aurais besoin de ré-optimiser l'ensemble de mon code. Pour l'instant, pas la peine de se prendre la tête. C'est parfaitement en accord avec la réponse que j'espérais avoir du forum. Néanmoins c'est noté.
Je reviens très rapidement sur le code proposé par Ucfoutu. Lors de mes tests, j'ai pu regarder la rapidité d'exécution de la procédure "MISE_EN_FORME" sur un gros fichier. Je n'ai donc pas transférer la procédure sur mes anciennes applis.
Le code fonctionne bien...mais il y a une toute petite feinte que je ne parviens pas à résoudre.
Dans le code que je propose, une fois que j'appelle ma procédure "MISE_EN_FORME" je peux entrer un paramètre en tant qu'Union. Et je ne parviens pas à trouver une solution équivalente avec ce nouveau code ???
Quelle serait la méthode, l'astuce, la modfif de code pour pouvoir entrer un Union de Range en tant que paramètre d'entré ? C'est possible ou c'est une limitation du nouveau code du coup ?
Ucfoutu, si tu as l'occasion de repasser par ici je suis intéressé pour savoir comment passer outre mon Union.
