Bug Macro
S
Bonjour à vous,
Me revoilà avec de nouveaux soucis liées à une macro.
Je vous mets un fichier en exemple ci-joint.
Le tableau, comme son nom l'indique, permets de faire un suivi d'anomalies en notifiant les personnes par e-mail, selon l'état d'avancement de l'anomalie cela prévient une nouvelle persone etc.
Mais depuis la dernière MàJ du fichier par un user lorsque je souhaite exécuter la macro, cela plante complétement
Pouvez-vous m'aider ? N'hésitez pas à me dire s'il vous fallait davantage d'informations pour éclaircir le sujet.
bonjour,
proposition de correction de ton code
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
' envoi un mail automatique avec le contenu de l'anomalie
' Consignes de migration: rajouter un statut "Non diffusée" dans la dernière colonne du tableau
' Donner accès à Excel 2010
' Intégrer la liste de diffusion
' Contrôle de statut " Non diffusée
Dim ol As Object, monItem As Object
Dim i
Dim j
Dim k
Dim cont
Dim datar
Dim expéditeur
Dim zone
Dim relance
Dim motif
Dim statut
Dim da
Dim ligne
Dim jour
Dim mailing
Dim copie
i = 2
j = 2
te = 0
k = 2
Sheets("suivi").Range("Z:Z").ClearContents
dl = Sheets("suivi").Cells(Rows.Count, 4).End(xlUp).Row
Set ol = CreateObject("outlook.application")
' On récupère la ou les lignes concernées par un éventuel envoi
For i = 2 To dl
If Worksheets("Suivi").Range("W" & i).Value = "ENVOI" Then
Worksheets("Suivi").Range("Z" & j).Value = i
j = j + 1
End If
Next i
' On envoie les mails concernés
While Worksheets("Suivi").Range("Z" & k).Value <> ""
cont = CInt(Worksheets("Suivi").Range("Z" & k).Value)
'On récupère les données
datar = Worksheets("Suivi").Range("D" & cont).Value
expéditeur = Worksheets("Suivi").Range("G" & cont).Value
zone = Worksheets("Suivi").Range("H" & cont).Value
relance = Worksheets("Suivi").Range("S" & cont).Value
ligne = Worksheets("Suivi").Range("A" & cont).Value
da = Worksheets("Suivi").Range("E" & cont).Value
statut = Worksheets("Suivi").Range("R" & cont).Value
anomalie = Worksheets("Suivi").Range("L" & cont).Value
jourano = Worksheets("Suivi").Range("B" & cont).Value
mailing = Worksheets("Suivi").Range("N" & cont).Value
copie = Worksheets("Suivi").Range("U" & cont).Value
'On envoit le mail en question
Set monItem = ol.CreateItem(olMailItem)
'monItem.To = " brice.pacheco@toto.com "
If statut = "Non diffusée" Then
monItem.To = mailing
monItem.Cc = copie & " ; brice.pacheco@toto.com "
monItem.Subject = anomalie & " - " & expéditeur & " " & zone & " - le " & da
monItem.Body = "Bonjour à tous," & Chr(13) & Chr(13) & "Une anomalie en réception retour a été remontée sur l'arrivage du " & datar & " du client " & expéditeur & " dans le tableau Suivi Anomalies Retours (K:\SUIVI ANOMALIES RETOURS) à la ligne " & ligne & "." & Chr(13) & Chr(13) & "Merci de vous rendre dans le tableau afin de donner les éléments de résolution dans les plus brefs délais."
monItem.send
'On change le statut de l'anomalie
Worksheets("Suivi").Range("R" & cont).Value = "Attente GY"
Else
If relance = "Relance" Then
monItem.To = mailing
monItem.Cc = copie & " ; brice.pacheco@toto.com "
monItem.Subject = "RELANCE " & anomalie & " - " & expéditeur & " " & zone & " - le " & da
monItem.Body = "Bonjour à tous," & Chr(13) & Chr(13) & "L'anomalie remontée dans le tableau Suivi Anomalies Retours (K:\) à la ligne " & ligne & " n'a pas encore trouvée de réponse de la part de l'équipe toto depuis " & jourano & " jours." & Chr(13) & Chr(13) & "Merci de vous rendre dans le tableau afin de donner les éléments de résolution dans les plus brefs délais."
monItem.send
'On incrémente le compteur Relance et stop la relance
Worksheets("Suivi").Range("T" & cont).Value = Worksheets("Suivi").Range("T" & cont).Value + Worksheets("Suivi").Range("X" & cont).Value
Worksheets("Suivi").Range("S" & cont).Value = ""
Else
If statut = "Attente GY" And relance = "" Then
monItem.To = " r.toto@tata-fashion.fr "
monItem.Cc = copie & " ; brice.pacheco@toto.com "
monItem.Subject = "RE: " & anomalie & " - " & expéditeur & " " & zone & " - le " & da
monItem.Body = "Bonjour à tous," & Chr(13) & Chr(13) & "L'anomalie remontée dans le tableau Suivi Anomalies Retours (K:\) à la ligne " & ligne & " a été résolue par l'équipe toto." & Chr(13) & Chr(13) & "Merci de traiter le dossier dans les plus brefs délais et mettre à jour le statut de l'anomalie dans le tableau."
monItem.send
'On change le statut de l'anomalie
Worksheets("Suivi").Range("R" & cont).Value = "Attente tata"
End If
End If
End If
k = k + 1
Wend
Worksheets("Suivi").Range("Z:Z").ClearContents
End Sub
S
Résolu, merci (j'ai répondu super tard