Discussion :

[LeDebile95]

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) :



que je dois transformer chaque jour comme ceci :



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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 ?

[ARTURO83]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[LeDebile95]

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 :



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

[ARTURO83]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[LeDebile95]

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



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

[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.