Bug Macro

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

Résolu, merci (j'ai répondu super tard )

Rechercher des sujets similaires à "bug macro"