Envoi ActiveSheet Excel en pdf via e-mail auto Thunder

Zut...

Je ne comprends pas pourquoi cela vous a fait ça.

Je viens de le rouvrir à tout hasard, mais il s'est bien ré ouvert sans pb.

Il s'agit bien d'un fichier .xlsm

Je vous le renvoie.

Merci beaucoup pour votre aide

Bonjour,

re-voici votre fichier, j'ai mis les macro sur le Module3

j'ai ouvert votre fichier malgré l'avertissement, Excel à fait la réparation suivante:

excel msg erreur 2

Bonjour SabV,

Merci pour votre envoi.

J'ai pu faire le test de votre macro rectifiée sur le module 3; presque tout est fonctionnel

Je dis presque, car j'ai toujours ce défaut de "déverrouillage du pavé numérique" qui se fait tout seul, lors de l'envoi de l'e-mail en automatique...je ne sais pas pourquoi?

Une idée sur cette erreur?

En revanche, vous que vous avez l'air de bien toucher en VBA, pensez-vous qu'il soit possible de pouvoir jumeler la macro "d'envoi par e-mail" que vous avez modifiée sous le module 3, avec la macro "soumettre" actuellement sous le module 1...?

Sachant que du coup, si cela est possible, je pense que la partie du code du module 1 concernant la message box de début d'execution de macro ne sera plus utile; voici le code du début du code du module 1 concernant la message box (à supprimer si jumelage possible?):

Dim Rep As Integer
        yourmsgbox = MsgBox("Avez-vous bien procédé à l'Etape 1 (permettant d'envoyer votre demande par e-mail) avant de réaliser cette étape de validation (Etape 2)? ", vbOKCancel + vbExclamation, "Demande de confirmation")
        If yourmsgbox = vbCancel Then
        Exit Sub
        End If
        If yourmsgbox = vbOK Then
        End If

Si ça fonctionne, ça allègerai grandement la fluidité de l'utilisation du fichier

Merci encore pour votre investissement et les résultats bénéfiques obtenus.

Bonjour,

voici une nouvelle version à tester,

Bonsoir SabV (et le Forum )

Merci pour l'envoi de ce nouveau fichier modifié.

ça avance, et voici le résultat de retour du test:

  • le message crée via Thunderbird, s'affiche dans une nouvelle fenêtre avec toutes les infos nécessaires et remplies, et la pièce jointe...mais celui-ci ne part pas automatiquement
  • le verrouillage numérique du pavé numérique se désactive encore tout seul

Et là, j'avoue que je m'en remet à vous, car cela dépasse mes petites compétences.

En vous remerciant par avance des idées que vous pourriez me proposer.

Bonjour SabV

Pensez-vous que l'envoi automatique du message ne se fait plus à cause (peut-être?) du délai dans time value da la Sub Test_Mail_TB qui est à 4 secondes, alors que celle de la Private Sub Mail_TB est à 3 secondes ?

Je sais que ces notions de délais (bien que différentes) étaient fonctionnelles avant l'intégration de la macro Soumettre via la fonction "Call" dans Sub Test; mais faudrait-il que j'augmente ce délai, ou le réduire?

En revanche, je vois bien que l'intégration de la commande du verrouillage numérique est là dans le code Sub Test_Mail_TB:

    Application.Wait (Now + TimeValue("0:00:04"))
       Kill ssRep & "\" & ssNomFic
Application.SendKeys ("{NUMLOCK}"), True

mais faudrait-il que cette commande soit aussi reportée en fin de Private Sub Mail_TB, car elle n'y apparaît pas:

Application.Wait (Now + TimeValue("0:00:03"))
SendKeys "^{ENTER}", True

Encore merci d'avance pour votre investissement et vos retours

Bonsoir SabV,

Et l'Equipe du Forum

Bon...après avoir testé le doublon de "NUMLOCK" sur Sub et Private Sub...

Pas d'amélioration sur la totalité du pb d'envoi et du pb verrouillage numérique, j'ai donc testé à descendre la valeur du Time Value de la Sub à 3"...

Et là, nickel...ça fait le boulot demandé...

Je suis juste dégouté de voir que maintenant c'est mon pb de code dans la fonction "Soumettre" qui ne veut pas me reporter les couleurs des cases de ma feuille 1 (Demande d'Intervention) qui correspondent à des indicateurs d'urgence ou priorités; dans le tableau des demandes reçues (colonnes indicateurs).

Je vous remet mon fichier en PJ avec le code qui doit poser souci à ce niveau, ou qui est erroné, je pense...aux niveaux des 3 cases à reporter.

(module1 - Sub Soumettre)

Feuil 1; case C24 sur menu déroulant (Urgence, à choisir grâce au menu déroulant)

Feuil 1; case C26 sur menu déroulant (Dangerosité, à choisir grâce au menu déroulant)

Feuil 1; case G26 sur menu déroulant (Niveau de blocage, à choisir grâce au menu déroulant)

Je voudrai que les différentes couleurs des cases C24, C26 et G26 (sans le texte) soit juste reportées dans la feuil 4 "Demandes reçues" respectivement en:

  • lign+1 colonne C pour "C24"
  • lign+1 colonne D pour "C26"
  • lign+1 colonne E pour "G26"

Malheureusement mon code actuel me fait reporter des cases blanches... Les indicateurs ne sont donc pas reportés.

Une idée sur mon dernier pb SVP

On touche au but Youpi Youpi

On va pas tarder à passer en résolu...lol...

Merci encore pour tout, pour toutes vos aides précieuses ou retours possibles.

Bonjour,

il n'y a pas de couleur sur les cellules C24, C26 et G26 de l'onglet "Demandes reçues" alors c'est normal.

Mais si...

Effectivement là actuellement c'est exact, mais quand vous remplissez la demande aux cellules concernant, s'affiche un menu-déroulant où vous pouvez sélectionner ce que vous considérez par rapport à votre demande...les couleurs varient entre vert/orange/rouge.

Faites le test sur les 3 cellules concernées, vous verrez

C'est là que le problème se corse, puisque je n'ai pas de report de ces couleurs dans le tableau des demandes reçues, si des caractéristiques d'Urgence/Bloquant/dangerosité sont sélectionnées.

J'ai revérifié le code, mais ma commande de report pour ces 3 cases n'est peut-être pas bonne.

Merci à vous pour votre grand intérêt et pour votre aide précieuse

Et ce n'est pas les cases de la feuille demandes reçues que j'avais cité, mais bien les cellules de la Demande d'Intervention (feuil 1) qui ne sont justement pas reportées sur "demandes reçues".

ce n'est pas une couleur à proprement dit mais une MFC, il faudrait appliquer la même MFC

c'est à dire ='Table des matières'!$J$4

etc..

Donc pour reporter la mise en forme conditionnelle (MFC), il faudrait que dans la macro soumettre (qui me valide et reporte la totalité des valeurs cellules de ma feuille "demande d'intervention" dans une nouvelle ligne du tableau "demandes reçues") soit ainsi:

Sub Soumettre()

        Dim lign As Variant

        lign = Sheets("Demandes reçues").Range("A65000").End(xlUp).Row

        If Sheets("Demandes reçues").Range("A" & lign).Value <> "" Then
        Sheets("Demandes reçues").Range("A" & lign + 1).Value = Sheets("Demande d'Intervention").Range("B47").Value
        Sheets("Demandes reçues").Range("B" & lign + 1).Value = Sheets("Demande d'Intervention").Range("C47").Value

        Sheets("Demandes reçues").Range("C" & lign + 1).Interior.ColorIndex = Sheets("Demande d'Intervention").Range("C24").Interior.ColorIndex
        Sheets("Demandes reçues").Range("D" & lign + 1).Interior.ColorIndex = Sheets("Demande d'Intervention").Range("C26").Interior.ColorIndex
        Sheets("Demandes reçues").Range("E" & lign + 1).Interior.ColorIndex = Sheets("Demande d'Intervention").Range("G26").Interior.ColorIndex

        Sheets("Demandes reçues").Range("F" & lign + 1).Value = Sheets("Demande d'Intervention").Range("D8").Value
        Sheets("Demandes reçues").Range("G" & lign + 1).Value = Sheets("Demande d'Intervention").Range("C16").Value
        Sheets("Demandes reçues").Range("H" & lign + 1).Value = Sheets("Demande d'Intervention").Range("D18").Value
        Sheets("Demandes reçues").Range("I" & lign + 1).Value = Sheets("Demande d'Intervention").Range("C20").Value
        Sheets("Demandes reçues").Range("J" & lign + 1).Value = Sheets("Demande d'Intervention").Range("D22").Value
        Sheets("Demandes reçues").Range("K" & lign + 1).Value = Sheets("Demande d'Intervention").Range("D12").Value
        Sheets("Demandes reçues").Range("L" & lign + 1).Value = Sheets("Demande d'Intervention").Range("C33").Value
        Sheets("Demandes reçues").Range("M" & lign + 1).Value = "Superviseur Travaux"
        Sheets("Demandes reçues").Range("N" & lign + 1).Value = Sheets("Demande d'Intervention").Range("C16").Value
        Sheets("Demandes reçues").Range("O" & lign + 1).Value = "En attente"
        Sheets("Demandes reçues").Range("P" & lign + 1).Value = Sheets("Demande d'Intervention").Range("C10").Value
        Sheets("Demandes reçues").Range("Q" & lign + 1).Value = Sheets("Demande d'Intervention").Range("H12").Value
        Sheets("Demandes reçues").Range("R" & lign + 1).Value = Sheets("Demande d'Intervention").Range("H14").Value
        Sheets("Demandes reçues").Range("S" & lign + 1).Value = Sheets("Demande d'Intervention").Range("D14").Value
        Sheets("Demandes reçues").Range("T" & lign + 1).Value = Sheets("Demande d'Intervention").Range("B36").Value
        Sheets("Demande d'Intervention").Range("D8").ClearContents
        Sheets("Demande d'Intervention").Range("C10:H10").ClearContents
        Sheets("Demande d'Intervention").Range("H12").ClearContents
        Sheets("Demande d'Intervention").Range("D14:E14").ClearContents
        Sheets("Demande d'Intervention").Range("H14").ClearContents
        Sheets("Demande d'Intervention").Range("D18:E18").ClearContents
        Sheets("Demande d'Intervention").Range("D22:H22").ClearContents
        Sheets("Demande d'Intervention").Range("C24:E24").ClearContents
        Sheets("Demande d'Intervention").Range("C26:D26").ClearContents
        Sheets("Demande d'Intervention").Range("G26:H26").ClearContents
        Sheets("Demande d'Intervention").Range("G28:H28").ClearContents
        Sheets("Demande d'Intervention").Range("C31:E31").ClearContents
        Sheets("Demande d'Intervention").Range("C33:E33").ClearContents
        Sheets("Demande d'Intervention").Range("B36:H41").ClearContents
        Sheets("Demande d'Intervention").Range("C47").Value = Sheets("Demandes reçues").Range("B" & lign + 1) + 1
        MsgBox "Votre Demande d'Intervention a bien été impactée. Afin de la valider totalement, vous pouvez maintenant fermer le fichier", vbOKOnly + vbExclamation, "Etape cruciale de fin de validation!"
        End If     

J'ai séparé par un une Entrée les 3 lignes du code (Range C,D,E pour C24,C26, G26) qui me posent ce souci de report MFC; car j'ai malheureusement testé, mais je n'ai pas trouvé...

Une idée sur la formule envisagée directement dans la macro?

Merci d'avance de vos retours et améliorations à apporter.

Bonjour,

il faudrait remplacer les 3 lignes par ce code,

        With Sheets("Demande d'Intervention")

         Select Case .Range("C24").Value
          Case "Routine (U3)": Sheets("Demandes reçues").Range("C" & lign + 1).Interior.Color = RGB(0, 255, 0)
          Case "Urgence (U2)": Sheets("Demandes reçues").Range("C" & lign + 1).Interior.ColorIndex = RGB(255, 192, 0)
          Case "Urgence critique(U1)": Sheets("Demandes reçues").Range("C" & lign + 1).Interior.ColorIndex = RGB(255, 0, 0)
         End Select

         Select Case .Range("C26").Value
          Case "Non -dangereux": Sheets("Demandes reçues").Range("D" & lign + 1).Interior.Color = RGB(0, 255, 0)
          Case "dangereux": Sheets("Demandes reçues").Range("D" & lign + 1).Interior.ColorIndex = RGB(255, 192, 0)
          Case "Très dangereux": Sheets("Demandes reçues").Range("D" & lign + 1).Interior.ColorIndex = RGB(255, 0, 0)
         End Select

         Select Case .Range("G26").Value
          Case "Non-bloquant": Sheets("Demandes reçues").Range("E" & lign + 1).Interior.Color = RGB(0, 255, 0)
          Case "Bloquant": Sheets("Demandes reçues").Range("E" & lign + 1).Interior.ColorIndex = RGB(255, 192, 0)
          Case "Très bloquant": Sheets("Demandes reçues").Range("E" & lign + 1).Interior.ColorIndex = RGB(255, 0, 0)
         End Select

        End With

Bonsoir SabV.

Merci pour votre retour.

J'ai intégré les lignes de code proposées, malheureusement je me retrouve avec un débogage de script.

Je vous met en PJ, les 2 photos pdf au moment de l’exécution de la macro.

De plus, je vous remet mon fichier modifié avec vos lignes de code intégrés.

Du coup, la macro de l'envoi ne s’exécute plus correctement puisque ça bug avant .

C'est rageant, il ne manque quasi rien....

Merci pour tout et les retours possibles.

oups mon erreur,

sur la macro Soumettre

remplacer tous les .Interior.ColorIndex par .Interior.Color

Je vous en prie...

Cela arrive, déjà que moi là, je "nage"...

Heureusement que vous êtes là...

Je teste ça dès ce matin et n'hésiterai pas à vous faire un retour dès que j'ai accès de nouveau à mon ordi perso

Encore merci.

Et à tout à l'heure pour le verdict, ou pour la suite à creuser....lol

Re-bonjour SabV

N'ayant pas TB en messagerie sur cet ordi, j'ai donc recrée un bouton d'exe macro pour réaliser le test de la Sub Soumettre.

J'ai donc modifié le code comme vous me l'avez dit, en supprimant les "index" de chaque "Color.Interior"

J'ai aussi procédé à la rectification de 2 petites "erreurs" de syntaxe (trois fois rien...lol) qui ne me permettait pas d'avoir le report de la couleur verte du "Non-dangereux" sélectionnée sur sheet "Demande d'Intervention", dans sheet "Demandes reçues"....le code ayant un espace de trop; je suis donc passé de:

Case "Non -dangereux": Sheets("Demandes reçues").Range("D" & lign + 1).Interior.Color = RGB(0, 255, 0)

à

Case "Non-dangereux": Sheets("Demandes reçues").Range("D" & lign + 1).Interior.Color = RGB(0, 255, 0)

J'ai rectifié la même "erreur" pour l'Urgence critique (U1), je suis donc passé de:

Case "Urgence critique(U1)": Sheets("Demandes reçues").Range("C" & lign + 1).Interior.Color = RGB(255, 0, 0)

à

Case "Urgence critique (U1)": Sheets("Demandes reçues").Range("C" & lign + 1).Interior.Color = RGB(255, 0, 0)

Du coup, pour le moment, en test juste de la Sub isolée Soumettre, le report est bien effectué. Je verrai si le Call et l'exe total de la macro se fait sans encombre sur l'ordi avec messagerie TB dans la matinée.

A ce propos, pensez-vous qu'il soit possible de pouvoir avoir des genres de petits ronds ou cercles d'indications avec le code couleurs reporté, à la place de la grosse case remplie? (cf PJ en pdf)

Si oui, est-ce une modif à apporter sur le code ou ai-je une modif particulière à réaliser sur le tableau de Sheet "Demandes reçues" ?

Je vous renvoi le fichier contenant les modifs effectuées

En vous remerciant encore pour votre grand intérêt et la grande aide apportée et les réponses et retours que vous pouvez m'apporter

Oouuups...

J'ai encore oublié une "petite" chose.

Le fichier pdf crée lors du précédent test avec TB porte le nom de "Demande d'intervention" uniquement; pensez-vous qu'il soit possible qu'il se nomme avec les infos contenues dans les cellules B47 & C47; soit pour l'exemple du fichier actuel "DI-20180524" contenu en "B47", et "0070" contenu en "C47".

Ce qui donnerait en nomination de la PJ "Demande d'Intervention DI-20180524-0070"...

Si c'est possible, bien sûr...si pas possible...dommage, mais tant pis...

Merci encore pour vos retours précieux

Bonsoir SabV,

Désolé de ne pouvoir répondre que maintenant, j'ai pu effectuer le test du nouveau code élaboré sous TB.

Malheureusement 2 erreurs se sont révélées.

En effet, maintenant que la Sub Soumettre est en Call sous la Sub Test_Mail_TB, la message box de la fin de macro "Soumettre"

 MsgBox "Votre Demande d'Intervention a bien été impactée. Afin de la valider totalement, vous pouvez maintenant fermer le fichier", vbOKOnly + vbExclamation, "Etape cruciale de fin de validation!"

s'exécute avant la message box qui se situe quant à elle dans la 1ère partie de la Sub Test_Mail_TB

Sub Test_Mail_TB()
Dim ssRep As String, ssNomFic As String
ssRep = ThisWorkbook.Path
ssNomFic = "Demande_Intervention.pdf"

Call Soumettre
    yourmsgbox = MsgBox("Avez-vous bien rempli la totalité des informations nécessaires à votre 'Demande d'Intervention' afin de procéder à l'envoi et à la validation de celle-ci ? ", vbOKCancel + vbExclamation, "Demande de confirmation")

    If yourmsgbox = vbCancel Then
      Exit Sub
    End If
      If yourmsgbox = vbOK Then
       Mail_TB ssRep, ssNomFic
       Application.Wait (Now + TimeValue("0:00:04"))
       Kill ssRep & "\" & ssNomFic
    End If
End Sub

Malheureusement, il faudrait que ces deux messages box soient "inversées" dans l'ordre d’exécution.

J'ai essayé, mais malheureusement ça n'a pas fonctionné

J'ai aussi essayé de voir si je ne pouvais pas trouver une solution pour l’appellation de mon fichier pdf généré lors de l'exe de la macro en modifiant le code comme ceci:

Sub Test_Mail_TB()
Dim ssRep As String, ssNomFic As String
ssRep = ThisWorkbook.Path
ssNomFic = "Demande Intervention" & Range("B47").Value & "-" & Range("C47").Value & ".pdf"

Call Soumettre
    yourmsgbox = MsgBox("Avez-vous bien rempli la totalité des informations nécessaires à votre 'Demande d'Intervention' afin de procéder à l'envoi et à la validation de celle-ci ? ", vbOKCancel + vbExclamation, "Demande de confirmation")

    If yourmsgbox = vbCancel Then
      Exit Sub
    End If
      If yourmsgbox = vbOK Then
       Mail_TB ssRep, ssNomFic
       Application.Wait (Now + TimeValue("0:00:04"))
       Kill ssRep & "\" & ssNomFic
    End If
End Sub

Private Sub Mail_TB(sRep As String, sNomFic As String)
Dim tTo As String, tCC As String, tBCC As String, tSujet As String, fichier As String
Dim objShell
Set objShell = CreateObject("WScript.Shell")

sRep = ThisWorkbook.Path
sNomFic = "Demande Intervention" & Range("B47").Value & "-" & Range("C47").Value & ".pdf"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sRep & "\" & sNomFic, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False

strHtml = "Bonjour, </font></BR>"
strHtml = strHtml & "<BR>" & _
"Vous avez reçu une nouvelle Demande d'Intervention validée à l'instant. </font></BR>"
strHtml = strHtml & "<BR>" & _
"Merci de bien vouloir la prendre en compte. </font></BR>"
strHtml = strHtml & "<BR>" & _
"<font color=black>Bien cordialement.</font>" & "<BR><BR>"
strHtml = strHtml & "<BR>" & _
"<font color=blue>L'équipe Travaux. </font>" & "<BR>"
strHtml = strHtml & "<BR><BR>"
strHtml = strHtml & Environ("UserName")
strHtml = strHtml & ""

tTo = "xxxxxxx@xxxxxxxx.fr"
tCC = "xxxxxxxxxx@xxxxxxxxx.fr"
tBCC = "xxxxxxxxx@xxxxxxxxxxx.fr"
tSujet = "Nouvelle Demande D'intervention reçue"
fichier = sRep & "\" & sNomFic

objShell.Exec ("%ProgramFiles%\Mozilla Thunderbird\thunderbird.exe -compose" & _
" preselectid='id1'" & _
",to='" & tTo & "'" & _
",cc='" & tCC & "'" & _
",bcc='" & tBCC & "'" & _
",newsgroups=''" & _
",subject='" & tSujet & "'" & _
",body='" & strHtml & "'" & _
",attachment='" & fichier & "'" & _
",bodyislink='false'" & _
",type='0'" & _
",format='1'" & _
",originalMsg=''" & _
"")

Application.Wait (Now + TimeValue("0:00:03"))
SendKeys "^{ENTER}", True

Set objShell = Nothing
End Sub

Mais malheureusement, là aussi, je me retrouve avec un débogage de script, qui m'ammene au ligne:

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sRep & "\" & sNomFic, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False

Je suis perdu là...j'ai voulu aller tellement vite et j'étais tellement plein d'engouements à l'idée que quelqu'un répondait et que malgré tout, le fichier a avancé...que je ne me suis pas rendu compte de ces 2 détails qui ne sont malheureusement pas anodins pour mon suivi.

En vous remerciant encore pour l'aide déjà apportée et que vous pourrez à nouveau m'apporter ou conseiller.

Bonjour,

j'ai inversé le msg et l'appel de la macro soumettre

à tester,

Sub Test_Mail_TB()
Dim ssRep As String, ssNomFic As String
ssRep = ThisWorkbook.Path
ssNomFic = "Demande_Intervention.pdf"

yourmsgbox = MsgBox("Avez-vous bien rempli la totalité des informations nécessaires à votre 'Demande d'Intervention' afin de procéder à l'envoi et à la validation de celle-ci ? ", vbOKCancel + vbExclamation, "Demande de confirmation")

Call Soumettre

    If yourmsgbox = vbCancel Then
      Exit Sub
    End If
      If yourmsgbox = vbOK Then
       Mail_TB ssRep, ssNomFic
       Application.Wait (Now + TimeValue("0:00:04"))
       Kill ssRep & "\" & ssNomFic
    End If
End Sub
Rechercher des sujets similaires à "envoi activesheet pdf via mail auto thunder"