Envoi ActiveSheet Excel en pdf via e-mail auto Thunder
Bonjour SabV
Merci pour votre suivi.
Je vous fait part du pb de compilation suite à l'intégration du bout de code proposé en remplacement de l'ancien
objShell.Exec ("%ProgramFiles%\Mozilla Thunderbird\thunderbird.exe -compose" & _Le nouveau intégré avec proposition me fait défaut (cf photo en pièce jointe).
Pensez-vous que j'ai mal rédigé le chemin d'accès demandé? Ou l'ai-je mal inséré au bon endroit?
En vous remerciant par avance.
re,
il faut mettre toute la chaine objShell.Exec.....
x = Environ("PROCESSOR_ARCHITECTURE")
Select Case x
Case "x86": pgf = "%ProgramFiles%"
Case "AMD64": pgf = "%ProgramFiles(x86)%"
End Select
objShell.Exec ("" & pgf & "\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=''" & _
"")Bonjour à toutes et à tous, chers membres du forum et contributeurs.
Je reviens vers vous suite, à une modification de mon fichier qui fonctionnait très bien jusqu'alors, et pour lequel je remercie la totalité des participants qui m'ont apportés "grand aide" dans la finalisation de ce fichier (en particulier, i20100)
Cependant, afin de répondre à un besoin d'évolution de structure du tableur, j'aurai voulu savoir si il était possible de:
1) -pouvoir sauvegarder les informations/valeurs de toutes les cellules qui étaient sélectionnées jusqu'alors sur mon ActiveSheet "Demande d'Intervention", et transférées sur l'onglet "Suivi".....si il est possible, vu que j'ai 3 sites différents à gére....que en fonction de la valeur choisie d'une cellule allouée aux sites proposée via menu déroulant, et correspondant aux 3 noms des onglets/feuilles que j'ai après mon Activesheet "DI", que seul l'onglet/feuille dédié au site choisi puisse récupérer les données en créant une ligne supplémentaire au tableau existant déjà sous cet onglet? J'ai bien essayer de faire des recherches sur le sujet, mais il est + proposé l'inverse (récup d'infos de différents onglets pour remettre sur une feuille unique) que des reculs des données et les classer en créant une nouvelle ligne uniquement sur le tableau de la feuille(onglet) concernée (en fonction du nom).
2° Petit problème pour repenser le code, si mon envoi automatique par e- mail viendrait à changer (prévu prochainement) via Gmail.
J'ai bien fouillé également, avec en codage l'utilisation de CDO, mais le souci est que je ne suis pas le seul à utiliser ce fichier...donc ça pose un souci, vu que le codage CDO demande d'intégrer les paramètres Serveur (smtp.gmail) , ainsi que fourni identifiant et code accès à ce type de messagerie.
Donc si je rentre mes informations, c'est sous ma messagerie que mails vont partir, ou alors les autres utilisateurs vont se retrouver avec un blocage à l'exception de la macro au moment de l'envoi (si connecté avec leur propre compte Gmail-Perso)
Voilà, c'est déjà 2 gros problèmes à résoudre, sachant que le + "urgent" réside dans le fait que j'ai déjà les 3 sites en gestion et que je ne peux plus faire fonctionner mon code "en l'état'. Hormis pour 1 site, pour lequel le code était totalement fonctionnel.
Encore merci à tous par avance, et pour votre bienveillance.
Voici le code qui est (était, sur nouveau fichier) fonctionnel sur la sheet (la seule/onglet unique sur fichier initial) où sont (étaient, sur nouveau fichier)reportées les infos et qui permettait d'insérer une ligne en bas de tableau:
Private Sub Worksheet_Change(ByVal Target As Range)
' teste si la cellule juste au dessus est remplie
If Range("premiereCelluleApresTableau").Offset(-1) <> "" Then
' ajoute une ligne - la ligne s'insère au dessus
Application.EnableEvents = False ' pour ne pas se mordre la queue
Range("premiereCelluleApresTableau").EntireRow.Insert xlShiftDown
Application.EnableEvents = True
End If
End SubVoici le code qui me reportait les infos du site unique (au départ) de mon Active Sheet (DI), vers ma sheet/onglet de suivi (Suivi DI), et me vidait les cellules une fois que la Call "Sub Soumettre": était exécutée:
Sub Soumettre()
Dim lign As Variant
lign = Sheets("Suivi des D.I. Reçues & Travaux").Range("A65000").End(xlUp).Row
If Sheets("Suivi des D.I. Reçues & Travaux").Range("A" & lign).Value <> "" Then
Sheets("Suivi des D.I. Reçues & Travaux").Range("A" & lign + 1).Value = Sheets("Demande d'Intervention").Range("B47").Value
Sheets("Suivi des D.I. Reçues & Travaux").Range("B" & lign + 1).Value = Sheets("Demande d'Intervention").Range("C47").Value
Sheets("Suivi des D.I. Reçues & Travaux").Range("F" & lign + 1).Value = Sheets("Demande d'Intervention").Range("D8").Value
Sheets("Suivi des D.I. Reçues & Travaux").Range("G" & lign + 1).Value = Sheets("Demande d'Intervention").Range("C16").Value
Sheets("Suivi des D.I. Reçues & Travaux").Range("H" & lign + 1).Value = Sheets("Demande d'Intervention").Range("G16").Value
Sheets("Suivi des D.I. Reçues & Travaux").Range("I" & lign + 1).Value = Sheets("Demande d'Intervention").Range("D18").Value
Sheets("Suivi des D.I. Reçues & Travaux").Range("J" & lign + 1).Value = Sheets("Demande d'Intervention").Range("C20").Value
Sheets("Suivi des D.I. Reçues & Travaux").Range("K" & lign + 1).Value = Sheets("Demande d'Intervention").Range("G28").Value
Sheets("Suivi des D.I. Reçues & Travaux").Range("L" & lign + 1).Value = Sheets("Demande d'Intervention").Range("D22").Value
Sheets("Suivi des D.I. Reçues & Travaux").Range("M" & lign + 1).Value = Sheets("Demande d'Intervention").Range("D12").Value
Sheets("Suivi des D.I. Reçues & Travaux").Range("N" & lign + 1).Value = Sheets("Demande d'Intervention").Range("C33").Value
Sheets("Suivi des D.I. Reçues & Travaux").Range("O" & lign + 1).Value = Sheets("Demande d'Intervention").Range("C31").Value
Sheets("Suivi des D.I. Reçues & Travaux").Range("P" & lign + 1).Value = "Superviseur Travaux"""
Sheets("Suivi des D.I. Reçues & Travaux").Range("Q" & lign + 1).Value = Sheets("Demande d'Intervention").Range("C16").Value
Sheets("Suivi des D.I. Reçues & Travaux").Range("R" & lign + 1).Value = "En attente"
Sheets("Suivi des D.I. Reçues & Travaux").Range("S" & lign + 1).Value = Sheets("Demande d'Intervention").Range("C10").Value
Sheets("Suivi des D.I. Reçues & Travaux").Range("T" & lign + 1).Value = Sheets("Demande d'Intervention").Range("H12").Value
Sheets("Suivi des D.I. Reçues & Travaux").Range("U" & lign + 1).Value = Sheets("Demande d'Intervention").Range("H14").Value
Sheets("Suivi des D.I. Reçues & Travaux").Range("V" & lign + 1).Value = Sheets("Demande d'Intervention").Range("D14").Value
Sheets("Suivi des D.I. Reçues & Travaux").Range("W" & lign + 1).Value = Sheets("Demande d'Intervention").Range("B36").Value
End If
With Sheets("Demande d'Intervention")
Select Case .Range("C24").Value
Case "Routine (U3)": Sheets("Suivi des D.I. Reçues & Travaux").Range("C" & lign + 1) = 3
Case "Urgence (U2)": Sheets("Suivi des D.I. Reçues & Travaux").Range("C" & lign + 1) = 2
Case "Urgence opérationnelle (U1)": Sheets("Suivi des D.I. Reçues & Travaux").Range("C" & lign + 1) = 1
End Select
Select Case .Range("C26").Value
Case "Non-dangereux": Sheets("Suivi des D.I. Reçues & Travaux").Range("D" & lign + 1) = 3
Case "Dangereux": Sheets("Suivi des D.I. Reçues & Travaux").Range("D" & lign + 1) = 2
Case "Très dangereux": Sheets("Suivi des D.I. Reçues & Travaux").Range("D" & lign + 1) = 1
End Select
Select Case .Range("G26").Value
Case "Non-bloquant": Sheets("Suivi des D.I. Reçues & Travaux").Range("E" & lign + 1) = 3
Case "Bloquant": Sheets("Suivi des D.I. Reçues & Travaux").Range("E" & lign + 1) = 2
Case "Très bloquant": Sheets("Suivi des D.I. Reçues & Travaux").Range("E" & lign + 1) = 1
End Select
End With
If Sheets("Suivi des D.I. Reçues & Travaux").Range("A" & lign).Value <> "" Then
Sheets("Demande d'Intervention").Range("D8:E8").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("Suivi des D.I. Reçues & Travaux").Range("B" & lign + 1) + 1
End IfL'idée est que ça puisse me faire le même boulot, mais que ça puisse me recopier l'ensemble des données de l'active sheet (DI-Demande d'Intervention) où la macro est exécutée...vers une sheet(onglet) spécifique, portant le même nom que le site qui sera sélectionné via une cellule à menu déroulant de l'active sheet , permettant de renvoyer les données vers l'onglet en question portant exactement le même nom que le site choisi.
Si il vous faut le code de la Sub Principale aussi, je n'hésiterai pas à vous le faire parvenir.
En vous remerciant par avance ;-)
Concernant le 2ème point (moins "urgent"), et qui concerne le passage sous messagerie Gmail, voici le code de la Sub Principal où est indiqué la partie relative à l'axe du Process de Thunderbird, qu'il faudrait réussir à adapter et à passer sous Gmail:
Sub Envoi_Mail_TB()
Dim ssRep As String, ssNomFic As String
ssRep = ThisWorkbook.Path
With Sheets("Demande d'Intervention")
ssNomFic = "DI-" & Format(.Range("B47"), "yyyymmdd") & "-" & Format(.Range("C47"), "0000") & ".pdf"
End With
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:10"))
Kill ssRep & "\" & ssNomFic
Application.SendKeys ("{NUMLOCK}"), True
End If
Call 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!"
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")
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. </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>"
strHtml = strHtml & "<BR>" & _
"<font color=blue>L'Équipe Travaux. </font>" & "<BR><BR>"
strHtml = strHtml & "<BR>" & _
"<I>Ceci est un email automatique. Merci de ne pas y répondre.</I>" & "</font></BR>"
strHtml = strHtml & "<BR>"
strHtml = strHtml & Environ("UserName")
strHtml = strHtml & ""
tTo = "XXXXXXX@gmail.com;xxxxxxxxxx@gmail.com;xxxxxxxxxxxxx@live.fr"
quoi = Sheets("Demande d'Intervention").Range("G28").Value
If quoi = "" Then
tCC = ""
Else
With Sheets("Table des matières")
tCC = Application.Index(.Range("G:G"), Application.Match(quoi, .Range("D:D"), 0))
End With
End If
tBCC = "xxxxxxxxxxxxxx@hotmail.fr"
tSujet = "Nouvelle Demande d'Intervention reçue"
fichier = sRep & "\" & sNomFic
x = Environ("PROCESSOR_ARCHITECTURE")
Select Case x
Case "x86": pgf = "%ProgramFiles%"
Case "AMD64": pgf = "%ProgramFiles(x86)%"
End Select
objShell.Exec ("" & pgf & "\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:09"))
SendKeys "^{ENTER}", True
Set objShell = Nothing
End Sub