Macro pour mise en forme

Version imprimable

Voir 40 message(s) de cette discussion en une page

2 pièce(s) jointe(s)

Macro pour mise en forme

Bonjour,

Etant un incompétent sans aucune formation sur VBA, je sollicite votre aide.
Actuellement, je dois faire une macro sur un fichier que je reçois et le mettre en forme comme ceci (voir ci-dessous) :

Pièce jointe 594190

que je dois transformer chaque jour comme ceci :

Pièce jointe 594191

Sauf que avec la macro assisté d'excel je dois réécrire les nombres attaché à : contrat, date de traitement etc. J'ai des lignes en trop car celle-ci est adaptée qu'un un seul type de fichier. Je vous montre l'ignoble code produit par excel :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
 
Sub jkzhdfzehioe()
'
' jkzhdfzehioe Macro
'
 
'
    ActiveCell.FormulaR1C1 = "DATE DE TRAITEMENT :"
    Range("B1").Select
    ActiveCell.FormulaR1C1 = ""
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "NOMBRE DE CONTRAT PASSÉ EN GESTION : "
    Range("E1").Select
    ActiveCell.FormulaR1C1 = ""
    Range("G1").Select
    ActiveCell.FormulaR1C1 = ""
    Rows("2:6").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("D1").Select
    ActiveCell.FormulaR1C1 = ""
    Range("A2").Select
    ActiveCell.FormulaR1C1 = "NOMBRE DE CONTRAT PASSÉ EN GESTION : "
    Range("F1").Select
    ActiveCell.FormulaR1C1 = ""
    Range("A3").Select
    ActiveCell.FormulaR1C1 = "NOMBRE DE CONTRAT REJETÉ :"
    Columns("E:F").Select
    Selection.Delete Shift:=xlToLeft
    Columns("I:O").Select
    Selection.Delete Shift:=xlToLeft
    Columns("J:M").Select
    Selection.Delete Shift:=xlToLeft
    Columns("L:L").Select
    Selection.Delete Shift:=xlToLeft
    Columns("M:P").Select
    Selection.Delete Shift:=xlToLeft
    Range("A7:M60").Select
    Range("M7").Activate
    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
    Range("A7:M7").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.AutoFilter
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("A8:H60").Select
    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
    Range("I8:L41").Select
    Range("I41").Activate
    Selection.Style = "Currency"
    ActiveWindow.SmallScroll Down:=-33
    Range("A7").Select
    ActiveCell.FormulaR1C1 = "Apporteur affaire"
    Range("B9").Select
    Columns("A:A").ColumnWidth = 21.29
    Columns("A:A").ColumnWidth = 17.86
    Columns("B:B").ColumnWidth = 22.57
    Columns("B:B").ColumnWidth = 31.57
    Columns("C:C").ColumnWidth = 21.43
    Columns("C:C").ColumnWidth = 18.43
    Columns("D:D").ColumnWidth = 16.43
    Columns("E:E").ColumnWidth = 21.71
    Columns("F:F").ColumnWidth = 15.14
    Columns("G:G").ColumnWidth = 16
    Columns("H:H").ColumnWidth = 14
    Columns("I:I").ColumnWidth = 15.71
    Columns("J:J").ColumnWidth = 13.86
    Columns("K:K").ColumnWidth = 16.14
    Columns("L:L").ColumnWidth = 16.29
End Sub

Pouvez-vous me corriger s'il vous plaît ?

Bonjour,

Il aurait été souhaitable que indiquiez les colonnes à supprimer car on ne sait pas trop ce qu'on supprime avec tous ces décalages.
Voici un exemple à tester sur une COPIE de votre fichier et dire en retour ce qui ne va pas.
Code:

1 2 3 4 5 6 7 8 9 10 Sub Mise_en_forme() Application.ScreenUpdating = False Rows("2:6").Insert Shift:=xlDown Columns("E:F").Delete Shift:=xlToLeft Columns("I:P").Delete Shift:=xlToLeft Range("I8:L41").Style = "Currency" Columns("A:M").EntireColumn.AutoFit Range("A1:A3").Value = Application.Transpose(Array("DATE DE TRAITEMENT :", "NOMBRE DE CONTRAT PASSÉ EN GESTION : ", "NOMBRE DE CONTRAT REJETÉ :")) Range("A7:M60").Borders().Weight = xlThin End Sub
Cdlt

24/03/2021, 14h41
LeDebile95

1 pièce(s) jointe(s)

Bonjour,

Merci de votre réponse. Pour faire suite à votre message il faudrait supprimer les colonnes allant de : (E:F); (K:Q); (S:V); Y; (AA;AD)

Après avoir appliqué votre code je me retrouve avec ceci :

Pièce jointe 594204

Ainsi certaines colonnes ne sont pas au bon format.
Le "Nombre de contrat passé en gestion" se retrouve deux fois.
La valeur affecté à "nombre de contrat rejeté" a disparu.
Il manque la mise en forme (surlignage, centré, filtré) sur la Ligne 7.

Merci beaucoup de votre aide

Que mon code ne corresponde pas exactement à vos attentes, c'est normal puisque je ne connaissais les colonnes que vous effaciez. Sachez que lorsque on souhaite supprimer des colonnes, on part toujours de la dernière et en remontant vers la première, ainsi les colonnes à supprimer restent à leur place, ceci est valable pour les lignes aussi.
Le code rectifié
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 Sub Mise_en_forme() Application.ScreenUpdating = False Rows("2:6").Insert Shift:=xlDown Columns("AA:AD").Delete Shift:=xlToLeft Columns("Y:Y").Delete Shift:=xlToLeft Columns("S:V").Delete Shift:=xlToLeft Columns("K:Q").Delete Shift:=xlToLeft Columns("E:F").Delete Shift:=xlToLeft Range("I8:L41").Style = "Currency" Columns("A:M").EntireColumn.AutoFit Range("A1:A3").Value = Application.Transpose(Array("DATE DE TRAITEMENT :", "NOMBRE DE CONTRAT PASSÉ EN GESTION : ", "NOMBRE DE CONTRAT REJETÉ :")) Range("A7:M60").Borders().Weight = xlThin End Sub
Cdlt

24/03/2021, 16h10
LeDebile95

1 pièce(s) jointe(s)

Suite à la rectification du code je me retrouve avec ceci.

Pièce jointe 594209

La colonne F est beaucoup beaucoup trop grande tandis que la B et M pas assez.
Il manque le fait que la ligne 7 doit être centré, surligné, et filtré.
Je me retrouve aussi encore avec les problèmes suivants :
Le "Nombre de contrat passé en gestion" se retrouve deux fois.
La valeur affecté à "nombre de contrat rejeté" a disparu.

Merci beaucoup de votre aide
24/03/2021, 16h19
ARTURO83

Je n'ai aucune vison sur votre fichier (ce n'est pas l'image que vous avez mis qui m'aide à y voir plus clair), les colonnes supprimées sont celles que vous avez indiquées, s'il y en a une en double c'est que vous ne l'avez pas signalé.
Pour les largeurs de colonnes, vous pouvez les forcer vous même, avec l'aide l'enregistreur de macros, idem pour les différents formats de cellules.

Pour voir ce qui cloche dans le déroulement de la macro, faites du pas à pas avec la touche F8, et observez bien ce qui se passe.
25/03/2021, 11h05
LeDebile95

Comment puis-je vous envoyer les 2 fichiers svp ?
25/03/2021, 11h08
ARTURO83

Bonjour,

Quand vous rédigez le message, cliquez sur l'icône "Trombone" puis sélectionnez le fichier
25/03/2021, 11h15
LeDebile95

1 pièce(s) jointe(s)

J'ai ce message lorsque j'utilise cette option :

Pièce jointe 594263

Le site n'autorise pas les fichiers excel je crois
25/03/2021, 11h22
ARTURO83

Citation:

Le site n'autorise pas les fichiers excel je crois

Nous sommes sur le forum excel et je peux vous assurer que les fichiers excel passent très bien.
Inutile d'envoyer le fichier en entier, ce qui importe c'est qu'il y ait toutes les colonnes et une dizaine de lignes seulement (sans données confidentielles)
25/03/2021, 11h29
LeDebile95

1 pièce(s) jointe(s)

Pièce jointe 594266

Voici les fichiers en question ! Merci de votre aide
25/03/2021, 12h04
ARTURO83

Voilà, avec le fichier c'est plus simple.

Ouvrez lefichier joint et cliquez sur le bouton bleu

Pièce jointe 594269

Pour les prochaines utilisations, ouvrez ce fichier, collez-y vos données puis cliquez sur le bouton.

Cdlt
25/03/2021, 12h19
LeDebile95

Incroyable merci beaucoup !!!

Pourriez-vous incrémenter dans la macro le fait que la colonne soit filtrée, le surlignage doit se faire en jaune ?
25/03/2021, 12h24
ARTURO83

Filtrée, oui mais sur quelle colonne?
25/03/2021, 12h29
LeDebile95

Filtré sur la Ligne 7 s'il vous plaît
25/03/2021, 12h34
ARTURO83

Citation:

Filtré sur la Ligne 7 s'il vous plaît

ça ne veut rien dire,
On doit faire un tri par colonne, mais que quelle colonne doit-on appliquer ce tri, sur la colonne A "Apporteur d'affaire", Sur la colonne B "Libellé du rejet", autre colonne, plusieurs colonnes en même temps?
25/03/2021, 12h35
LeDebile95

Sur les libellées de toutes les colonnes
25/03/2021, 12h51
ARTURO83

Visiblement vous ne comprenez pas la fonction du tri.

Généralement lorsqu'on fait un tri on choisit une ou plusieurs colonnes(mais pas toutes) sur lesquelles va s'appliquer le tri, ce dernier va entraîner toutes les colonnes du tableau dans la nouvelle organisation des lignes, heureusement sinon ce serait belle pagaille.

Il faut dire par rapport à quoi on va faire ce tri. Exemple: si on fait un tri par "libellé du rejet" (colonne B) par ordre ascendant, toutes les lignes du tableau vont être triées en respectant l'ordre demandée dans la colonne B, idem pour un choix différent.

Lorsque vous le faites manuellement quelles sont les actions que vous faites pour faire le tri?
25/03/2021, 13h33
LeDebile95

1 pièce(s) jointe(s)

Je suis bête, je voulais dire simplement filtrer je me suis trompé de mot et c'est vrai que sur excel ça change tout ! :lol:

Il faut que celle-ci soit filtrée comme ici :

Pièce jointe 594277
25/03/2021, 13h43
ARTURO83

Enfin, d'après ce que je vois, vous ne filtrez rien du tout, simplement vous voulez que l'affichage des flèches du filtre sur la ligne 7.

Voilà
Pièce jointe 594281

Voir 40 message(s) de cette discussion en une page