Description d'une macro

Version imprimable

Bonjour,

je fais appel aujourd'hui à vos connaissances en VBA afin de m'expliquer, par le biais de commentaires, la macro suivante:

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 Macro1()
On Error GoTo Err_Commande86_Click
'
' Macro1 Macro
' Macro enregistrée le 31/03/2009 par *********
'
    Range("I3:Bl500").Select
    Selection.Interior.ColorIndex = xlNone
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Selection.ClearComments
'
' à quoi cela correspond-il??
 
col = 8
a = ""
b = ""
c = ""
c1 = ""
c2 = ""
d = ""
e = ""
f = ""
cpt = 1
lots = ""
sem = ""
cumul = 0
nb = 0
 
For Each cellule In ActiveSheet.Range("A3:h500").Cells
f = e
e = d
d = c2
c2 = c1
c1 = c
c = b
b = a
a = cellule
 
If (cpt = col) Then
If (b <= Range("c1").Value) Then
sem = sem & "Sem " & Format(b, "ww", vbMonday, vbFirstJan1) & ";"
End If
End If
 
If (cpt = col And f = "") Then
lots = lots & cellule.Value & ";"
 
nb = nb + 1
End If
 
If (cpt = col And f <> "") Then
 
cumul = 0
cumul2 = 0
sous_total = 0
If (nb > 0) Then
sous_total = InStr(1, lots, ";")
sous_total = Mid(lots, 1, sous_total)
sous_total = Replace(sous_total, ";", "")
sous_total = Round(sous_total, 2)
lots = Replace(lots, sous_total & ";", "", 1, 1)
nb = nb - 1
End If
num_lot = 1
test = True
For Each Cellule2 In ActiveSheet.Range("L" & cellule.Row & ":BL" & cellule.Row).Cells
 
If (Cellule2.Value <> "") Then cumul = Int(Cellule2.Value) + cumul
If (Cellule2.Value <> "") Then cumul2 = Int(Cellule2.Value) + cumul2
ad = InStrRev(Cellule2.AddressLocal, "$")
ad = Mid(Cellule2.AddressLocal, 1, ad)
 
 
If (InStr(sem, Range(ad & "2").Value)) Then
Cellule2.Select
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThick
        .ColorIndex = 5
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThick
        .ColorIndex = 5
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThick
        .ColorIndex = 5
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThick
        .ColorIndex = 5
    End With
sem = Replace(sem, Range(ad & "2").Value & ";", "")
End If
 
If (cumul2 > sous_total And nb > 0) Then
Cellule2.Select
    With Selection.Interior
        .ColorIndex = 44
    End With
    Selection.AddComment
    Selection.Comment.Visible = True
    Selection.Comment.Text Text:="Fin de lot " & num_lot & "." & Chr(10) & cumul2 - sous_total & " KG pris sur le lot suivant."
    Selection.Comment.Visible = False
cumul2 = cumul2 - sous_total
num_lot = num_lot + 1
sous_total = InStr(1, lots, ";")
sous_total = Mid(lots, 1, sous_total)
sous_total = Replace(sous_total, ";", "")
sous_total = Round(sous_total, 2)
 
lots = Replace(lots, sous_total & ";", "", 1, 1)
nb = nb - 1
 
End If
 
 
If (cumul > cellule.Value And test = True) Then
Cellule2.Select
    With Selection.Interior
        .ColorIndex = 3
    End With
    Selection.ClearComments
    Selection.AddComment
    Selection.Comment.Visible = True
    Selection.Comment.Text Text:="Rupture :" & Chr(10) & "Manque de " & cumul - cellule.Value & " KG"
    Selection.Comment.Visible = False
    sous_total = 0
    lots = ""
    cumul2 = 0
    nb = 0
    test = False
'Exit For
End If
 
Next
 
End If
 
cpt = 1 + cpt
If (cpt > col) Then
cpt = 1
End If
Next
 
Range("A1").Select
 
Exit_Commande86_Click:
    Exit Sub
 
Err_Commande86_Click:
    MsgBox Err.Description
    Resume Exit_Commande86_Click
End Sub

En fait la première partie est pour moi imcompéhensible puisque je n'ai jamais fait ce genre de macro à mon très très modeste niveau!

Merci de m'aider et d'éclairer ma lanterne à ce sujet...

14/07/2010, 14h21
Jean-Philippe André

salut,

les premieres lignes indiquent un nettoyage des cadres dans tes cellules.

Les lignes de code suppriment (passent a xlNone) les cotes de ta selection de cellules.

Cela t'aide-t-il a mieux comprendre la macro ?

Et tu peux simplifier la première partie comme ceci

Code:

1
2
3
4
5
With Range("B3:Il500")
    .Interior.ColorIndex = xlNone   'enlève la couleur de fond des cellules
    .Borders.LineStyle = xlNone     'enlève toutes les bordures
    .ClearComments                  'enlève tous les commentaires
End With

14/07/2010, 19h00
chubak62

Merci pour vos réponses,

pour cette partie là oui j'avais compris (je me suis mal exprimé oups sorry)

c'est la suite, l'énumération que je ne comprend pas...

Mais je suppose qu'il devrait être difficile de répondre à ma question sans voir la macro fonctionnait...

Mais je n'ai pas le fichier sous la main, dès que je peux je la partage...

mais si vous arrivez à me dire à quoi cela pourrait juste correspondre cela m'aiderait grandement

Merci encore à vous!!
14/07/2010, 19h36
patricktoulon

heuh!!!
bonjour

toujours dans un souci de reduction de code inutile
tu peut deja remplacer toute tes lignes de netoyages par:
Code:

1 2 Range("I3:Bl500").clear
sa les vides ,enleves les cadre,enleve la couleur de fond, remet la couleur text en normal(noir),ect..enfin les cellule redevienne comme a l'origine

au plaisir

rebonjour,

je suis enfin de retour et prêt à m'occuper de cette histoire de macro dont je n'ai toujours pas saisi le sens du début de cette partie exactement :

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
 
col = 8
a = ""
b = ""
c = ""
c1 = ""
c2 = ""
d = ""
e = ""
f = ""
cpt = 1
lots = ""
sem = ""
cumul = 0
nb = 0
 
For Each cellule In ActiveSheet.Range("A3:h500").Cells
f = e
e = d
d = c2
c2 = c1
c1 = c
c = b
b = a
a = cellule
 
If (cpt = col) Then
If (b <= Range("c1").Value) Then
sem = sem & "Sem " & Format(b, "ww", vbMonday, vbFirstJan1) & ";"
End If
End If
 
If (cpt = col And f = "") Then
lots = lots & cellule.Value & ";"
 
nb = nb + 1
End If
 
If (cpt = col And f <> "") Then
 
cumul = 0
cumul2 = 0
sous_total = 0
If (nb > 0) Then
sous_total = InStr(1, lots, ";")
sous_total = Mid(lots, 1, sous_total)
sous_total = Replace(sous_total, ";", "")
sous_total = Round(sous_total, 2)
lots = Replace(lots, sous_total & ";", "", 1, 1)
nb = nb - 1
End If
num_lot = 1
test = True
For Each Cellule2 In ActiveSheet.Range("L" & cellule.Row & ":BL" & cellule.Row).Cells
 
If (Cellule2.Value <> "") Then cumul = Int(Cellule2.Value) + cumul
If (Cellule2.Value <> "") Then cumul2 = Int(Cellule2.Value) + cumul2
ad = InStrRev(Cellule2.AddressLocal, "$")
ad = Mid(Cellule2.AddressLocal, 1, ad)
 
 
If (InStr(sem, Range(ad & "2").Value)) Then
Cellule2.Select
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThick
        .ColorIndex = 5
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThick
        .ColorIndex = 5
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThick
        .ColorIndex = 5
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThick
        .ColorIndex = 5
    End With
sem = Replace(sem, Range(ad & "2").Value & ";", "")
End If
 
If (cumul2 > sous_total And nb > 0) Then
Cellule2.Select
    With Selection.Interior
        .ColorIndex = 44
    End With
    Selection.AddComment
    Selection.Comment.Visible = True
    Selection.Comment.Text Text:="Fin de lot " & num_lot & "." & Chr(10) & cumul2 - sous_total & " KG pris sur le lot suivant."
    Selection.Comment.Visible = False
cumul2 = cumul2 - sous_total
num_lot = num_lot + 1
sous_total = InStr(1, lots, ";")
sous_total = Mid(lots, 1, sous_total)
sous_total = Replace(sous_total, ";", "")
sous_total = Round(sous_total, 2)
 
lots = Replace(lots, sous_total & ";", "", 1, 1)
nb = nb - 1
 
End If
 
 
If (cumul > cellule.Value And test = True) Then
Cellule2.Select
    With Selection.Interior
        .ColorIndex = 3
    End With
    Selection.ClearComments
    Selection.AddComment
    Selection.Comment.Visible = True
    Selection.Comment.Text Text:="Rupture :" & Chr(10) & "Manque de " & cumul - cellule.Value & " KG"
    Selection.Comment.Visible = False
    sous_total = 0
    lots = ""
    cumul2 = 0
    nb = 0
    test = False
'Exit For
End If
 
Next
 
End If
 
cpt = 1 + cpt
If (cpt > col) Then
cpt = 1
End If
Next
 
Range("L3").Select
 
Exit_Commande86_Click:
    Exit Sub
 
Err_Commande86_Click:
    MsgBox Err.Description
    Resume Exit_Commande86_Click
End Sub

je ne vois pas à quioi correspond a, b, c1,c2 etc...

Merci pour vos réponses...je tente d'uploader le fichier de suite pour ceux qui voudrait avoir une vision globale de ce sur quoi je m'intéresses...(inutile pour mon cas pour le stage mais utile pour mes connaissance en VBA)

Merci encore à vous de prendre de votre temps...

1 pièce(s) jointe(s)

Voici le fichier en format .zip, seul logiciel installé sur le PC du lieu de mon stage et sur lequel je n'ai aucun droit (similaire à un compte visiteur)

Bref, j'éspère que vous pourrez me répondre.

Si cela ne vous embête pas, je sais que j'en demande déjà beaucoup, de mettre sous forme de commentaire dans la macro grâce à ce symbole ' le processus de cette macro

par exemple comme l'a très bien fait Mercatog :
Code:

1 2 3 4 5 6 With Range("B3:Il500") .Interior.ColorIndex = xlNone 'enlève la couleur de fond des cellules .Borders.LineStyle = xlNone 'enlève toutes les bordures .ClearComments 'enlève tous les commentaires End With '
Merci encore!

edit :

Les cases jaunes/oranges = lot terminé
cases rouges = rupture de stock
cases avec bordures bleues = fin de la DLUO d'un lot