Bug Macro

Y compris Power BI, Power Query et toute autre question en lien avec Excel
S
SoCRacK
Membre habitué
Membre habitué
Messages : 86
Inscrit le : 14 décembre 2016
Version d'Excel : 2016

Message par SoCRacK » 18 février 2019, 09:07

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

Pouvez-vous m'aider ? N'hésitez pas à me dire s'il vous fallait davantage d'informations pour éclaircir le sujet.
Suivi Anomalies Retours - Copie.xlsm
(443.01 Kio) Téléchargé 4 fois
h
h2so4
Passionné d'Excel
Passionné d'Excel
Messages : 7'788
Appréciations reçues : 211
Inscrit le : 16 juin 2013
Version d'Excel : 2013 UK Windows 10

Message par h2so4 » 18 février 2019, 09:47

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épondre Sujet précédentSujet suivant
  • Sujets similaires
    Réponses
    Vues
    Dernier message
  • bug macro
    par qassim » 18 décembre 2018, 14:19 » dans Excel - VBA
    1 Réponses
    73 Vues
    Dernier message par Steelson
    20 décembre 2018, 16:45
  • Bug macro
    par lyly_bou » 21 mars 2018, 09:37 » dans Excel - VBA
    1 Réponses
    45 Vues
    Dernier message par Patty5046
    21 mars 2018, 11:05
  • Bug macro
    par GREG34 » 15 janvier 2018, 06:11 » dans Excel - VBA
    8 Réponses
    118 Vues
    Dernier message par GREG34
    15 janvier 2018, 12:10
  • Bug macro mail
    par Math2810 » 30 octobre 2016, 20:30 » dans Excel - VBA
    1 Réponses
    90 Vues
    Dernier message par bouben
    30 octobre 2016, 21:43
  • Optimisation et Bug Macro
    par Aurely40 » 28 septembre 2017, 11:35 » dans Excel - VBA
    5 Réponses
    84 Vues
    Dernier message par Aurely40
    28 septembre 2017, 13:54
  • Bug macro doubleclick
    par Clem3411 » 5 juillet 2018, 12:06 » dans Excel - VBA
    2 Réponses
    121 Vues
    Dernier message par ExcelCoreGame
    6 juillet 2018, 17:59