Discussion :

[jarault]

Bonjour,

J'ai mis en place le code suivant basé sur un "Worksheet_SelectionChange":

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
Sub Incorporer_Ventes()
Dim i As String, j As String, k As String
Dim x As Integer, m As Integer
Dim Fam As String
Application.ScreenUpdating = False
Application.EnableEvents = False
i = ActiveCell.Offset(0, -12)
j = ActiveCell.Offset(0, -10)
k = ActiveCell.Offset(0, -6)
x = ActiveCell.Row
If (k = "") And (j <> "") And (i <> "") Then ActiveCell.Offset(0, -6).Value = "PRE-VENDU" 'Met dépôt pré-vendu si il y a qté et produit et pas de dépôt d'affecté
If (i = "") And (j = "") Then Exit Sub 'quitte si pas qte et produit
If ActiveCell.Offset(0, -6).Interior.ColorIndex = 6 Then Exit Sub Else 'vérifie si le produit est déjà déstocké
 
Fam = Sheets("VENTES").Cells(x, 36) & Sheets("VENTES").Cells(x, 37) 'affecte produit et famille
For m = 3 To 122 'affecte la plage de colonnes pour le destockage
    If Sheets("DEPOTS").Cells(2, m) & Sheets("DEPOTS").Cells(3, m) = Fam Then ' vérifie que la colonne correspond au produit
        Sheets("DEPOTS").Cells(x + 191, m) = Sheets("VENTES").Cells(x, 3) 'remplit la quantité dans le stock
        Sheets("DEPOTS").Cells(x + 191, 1) = Sheets("VENTES").Cells(x, 21) 'remplit le nom du client
        Sheets("DEPOTS").Cells(x + 191, 2) = Sheets("VENTES").Cells(i, 22) 'remplit le transporteur
        Sheets("DEPOTS").Cells(x + 191, 125) = Sheets("ACHATS").Cells(i, 9) 'remplit le dépôt
 
        Exit For
    End If
Next m
ActiveCell.Offset(0, -6).Interior.ColorIndex = 6
Application.EnableEvents = True
Application.ScreenUpdating = True
 
End Sub

Première question : Voyez-vous un moyen d'optimiser ce code ?
Deuxième question : sur la ligne suivante :

Code :

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

If ActiveCell.Offset(0, -6).Interior.ColorIndex = 6 Then Exit Sub Else 'vérifie si le produit est déjà déstocké

Je souhaiterais qu'un message d'avertissement s'affiche avant le Exit Sub
J'avais dans un premier temps essayé:

Code :

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

If ActiveCell.Offset(0, -6).Interior.ColorIndex = 6 Then MsgBox ("Produit déjà Déstocké") Else 'vérifie si le produit est déjà déstocké

Mais je n'arrive pas à afficher le message et faire un exit sub en même temps.

Merci par avance de votre aide,

Jarault

[Godzestla]

Je souhaiterais qu'un message d'avertissement s'affiche avant le Exit Sub
J'avais dans un premier temps essayé:
Code :
If ActiveCell.Offset(0, -6).Interior.ColorIndex = 6 Then MsgBox ("Produit déjà Déstocké") Else 'vérifie si le produit est déjà déstocké
Mais je n'arrive pas à afficher le message et faire un exit sub en même temps.

Fais plutot ceci

Code :

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

1
2
3
4
5
6
7
 
If ActiveCell.Offset(0, -6).Interior.ColorIndex = 6 Then
 MsgBox ("Produit déjà Déstocké") 
 exit sub
else
'vérifie si le produit est déjà déstocké
End if

[Commodore]

1ere question, ça a l'air déjà optimisé...

2e question: il est possible d'utiliser GoTo et une balise pour sortir du for et afficher ton msg.

exemple:

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
For i=x to y
  <instructions>
  Goto finfor
Next x
 
goto suite
finfor:
msgbox "mon message"
 
 
suite:
<instructions>

c'est peu déontologique, mais efficace

edit: grilled

[jarault]

Le code semble maintenant fonctionner correctement:

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
Sub Incorporer_Ventes()
Dim i As String, j As String, k As String
Dim x As Integer, m As Integer
Dim Fam As String
Application.ScreenUpdating = False
Application.EnableEvents = False
i = ActiveCell.Offset(0, -12)
j = ActiveCell.Offset(0, -10)
k = ActiveCell.Offset(0, -6)
x = ActiveCell.Row
 
If (k = "") And (j <> "") And (i <> "") Then ActiveCell.Offset(0, -6).Value = "PRE-VENDU" 'Met dépôt pré-vendu si il y a qté et produit et pas de dépôt d'affecté
If (i = "") And (j = "") Then Exit Sub 'quitte si pas qte et produit
 
'vérifie si le produit est déjà déstocké
If ActiveCell.Offset(0, -6).Interior.ColorIndex = 6 Then
 MsgBox ("Produit déjà Déstocké")
 Exit Sub
Else
End If
 
Fam = Sheets("VENTES").Cells(x, 36) & Sheets("VENTES").Cells(x, 37) 'affecte produit et famille
For m = 3 To 122 'affecte la plage de colonnes pour le destockage
    If Sheets("DEPOTS").Cells(2, m) & Sheets("DEPOTS").Cells(3, m) = Fam Then ' vérifie que la colonne correspond au produit
        Sheets("DEPOTS").Cells(x + 338, m) = Sheets("VENTES").Cells(x, 3) 'remplit la quantité dans le stock
        Sheets("DEPOTS").Cells(x + 338, 1) = Sheets("VENTES").Cells(x, 21) 'remplit le nom du client
        Sheets("DEPOTS").Cells(x + 338, 2) = Sheets("VENTES").Cells(x, 22) 'remplit le transporteur
        Sheets("DEPOTS").Cells(x + 338, 125) = Sheets("VENTES").Cells(x, 9) 'remplit le dépôt
 
        Exit For
    End If
Next m
 
'Colorie en jaune si il y a eu destockage
ActiveCell.Offset(0, -6).Interior.ColorIndex = 6
 
Application.EnableEvents = True
Application.ScreenUpdating = True
 
End Sub

Merci pour la rapidité des réponses
Jarault