Envoie d'un mail via VBA avec tableau ainsi que Graphique
Bonjour à tous, j'ai fais quelque recherches sur le forum afin de trouver une solution a mon soucis mais je n'ai pas trouver de réponse adéquate du coup je me redirige vers vous en espérant que l'un d'entre vous puisse m'éclairer.
Donc voici mon problème dans le but de mon travail j'ai crée un fichier excel répertoriant des demandes de client dans un tableau qui sont traité par une autre personne de ce faite j'ai crée des tableau regroupant les valeurs de demandes traités par jour ainsi que des graphique et désormais je cherche à faire une macro me permettant d'envoyer le tableau ainsi que le graphique du mois par mail, Pour ce qui est d'automatiser la tache par mois je n'ai pas encore trouver de solution.
(J'aimerais par exemple que si nous nous situons sur le mois de mars lorsque j'appuie sur mon bouton cela n'envoie que le fichier de Mars ainsi que le graphique de Mars), pour l'instant j'ai réussi à compiler tout les mois de l'année sur graphique et sur tableau afin de les envoyer tous en même temps mais même dans cette démarche j'ai des erreurs assez spécial par exemple des colonnes de février a la fin de mon tableau de mai etc.
Du coup voici mon problème j'aimerais pouvoir corriger ces petites erreurs et si cela est possible réussir a créer une boucle permettant d'identifier le mois de l'année et donc de n'envoyer que les données de ce mois.
Voici mon tableau lors de l'arrivée des demandes je ne peux malheureusement pas l'envoyé du faite de sa taille
Voici les tableau qui registre les demandes traitées ainsi que les demandes arrivante, ce sont ces tableaux que je cherche a envoyer
Enfin voici les graphique, comme vous pouvez le voir il sont chacun sur des feuilles différentes
Désormais voici le code que j'ai crée et qui ma permit de pouvoir envoyer mes graph en PJ et les tableau dans le corps du mail.
Sub envoi_mail()
Dim olk As Object, email As Object, wdDoc As Object
Dim erreur As Integer, nb_lignes As Integer
Dim rng As Object
Dim MyChart As Chart
Dim Date_Sending As String
On Error Resume Next 'désactivation routine d'erreur
erreur = False
'Assignation des applications Outlook ,de l'objet email et du body de l'email en tant que document Word
Set olk = CreateObject("outlook.application")
Set email = olk.CreateItem(olMailItem)
Set wdDoc = email.GetInspector.WordEditor
'****************************************************************
Set MyChart = Sheets("SuiviGraphique").ChartObjects(1).Chart 'adapter le nom de la feuille contenant le graphique
MyChart.Export Filename:=Environ("Temp") & "\graph1.jpg", filtername:="JPG"
Set MyChart = Sheets("SuiviGraphique").ChartObjects(2).Chart 'adapter le nom de la feuille contenant le graphique
MyChart.Export Filename:=Environ("Temp") & "\graph2.jpg", filtername:="JPG"
Set MyChart = Sheets("SuiviGraphique").ChartObjects(3).Chart 'adapter le nom de la feuille contenant le graphique
MyChart.Export Filename:=Environ("Temp") & "\graph3.jpg", filtername:="JPG"
Set MyChart = Sheets("SuiviGraphique").ChartObjects(4).Chart 'adapter le nom de la feuille contenant le graphique
MyChart.Export Filename:=Environ("Temp") & "\graph4.jpg", filtername:="JPG"
Set MyChart = Sheets("SuiviGraphique").ChartObjects(5).Chart 'adapter le nom de la feuille contenant le graphique
MyChart.Export Filename:=Environ("Temp") & "\graph5.jpg", filtername:="JPG"
Set MyChart = Sheets("SuiviGraphique").ChartObjects(6).Chart 'adapter le nom de la feuille contenant le graphique
MyChart.Export Filename:=Environ("Temp") & "\graph6.jpg", filtername:="JPG"
Set MyChart = Sheets("SuiviGraphique").ChartObjects(7).Chart 'adapter le nom de la feuille contenant le graphique
MyChart.Export Filename:=Environ("Temp") & "\graph7.jpg", filtername:="JPG"
Set MyChart = Sheets("SuiviGraphique").ChartObjects(8).Chart 'adapter le nom de la feuille contenant le graphique
MyChart.Export Filename:=Environ("Temp") & "\graph8.jpg", filtername:="JPG"
Set MyChart = Sheets("SuiviGraphique").ChartObjects(9).Chart 'adapter le nom de la feuille contenant le graphique
MyChart.Export Filename:=Environ("Temp") & "\graph9.jpg", filtername:="JPG"
Set MyChart = Sheets("SuiviGraphique").ChartObjects(10).Chart 'adapter le nom de la feuille contenant le graphique
MyChart.Export Filename:=Environ("Temp") & "\graph10.jpg", filtername:="JPG"
Set MyChart = Sheets("SuiviGraphique").ChartObjects(11).Chart 'adapter le nom de la feuille contenant le graphique
MyChart.Export Filename:=Environ("Temp") & "\graph11.jpg", filtername:="JPG"
Set MyChart = Sheets("SuiviGraphique").ChartObjects(12).Chart 'adapter le nom de la feuille contenant le graphique
MyChart.Export Filename:=Environ("Temp") & "\graph12.jpg", filtername:="JPG"
'*******************************************************************************
'***************************************************************************************************************************
'Sélection des fichier JPG les graphs
Set ColAttach = email.Attachments
Set oAttach = ColAttach.Add(Environ("Temp") & "\graph1.jpg")
Set oAttach = ColAttach.Add(Environ("Temp") & "\graph2.jpg")
Set oAttach = ColAttach.Add(Environ("Temp") & "\graph3.jpg")
Set oAttach = ColAttach.Add(Environ("Temp") & "\graph4.jpg")
Set oAttach = ColAttach.Add(Environ("Temp") & "\graph5.jpg")
Set oAttach = ColAttach.Add(Environ("Temp") & "\graph6.jpg")
Set oAttach = ColAttach.Add(Environ("Temp") & "\graph7.jpg")
Set oAttach = ColAttach.Add(Environ("Temp") & "\graph8.jpg")
Set oAttach = ColAttach.Add(Environ("Temp") & "\graph9.jpg")
Set oAttach = ColAttach.Add(Environ("Temp") & "\graph10.jpg")
Set oAttach = ColAttach.Add(Environ("Temp") & "\graph11.jpg")
Set oAttach = ColAttach.Add(Environ("Temp") & "\graph12.jpg")
'****************************************************************************************************************************
text1 = "Bonjour Philippe" & Chr(12) & Chr(12) & _
"Voici le suivi AVP003 du début du mois de Mars pour les fichier en traitement et clos " & Date_Sending & Chr(12) & Chr(12) & _
"Cordialement" & Chr(12) & ""
With email
'....... remplissage sujet, objet, et adresse
.To = "philippe.potier@orange.com"
.CC = "valentin.roma@orange.com"
.Subject = "Transfert flux AVP 03"
'....... corps du mail
.Display
With Sheets("TableauSuivi")
'Affichage du texte
'PremierTab JANVIER
.Range("F1:I20").Copy
nb_lignes = .Range("F1:I20").Rows.Count
Set rng = wdDoc.Content
rng.Paste
'2eme tableau FEVRIER
.Range("K1:N25").Copy
Set rng = rng.GoTo(What:=3, Which:=2, Count:=nb_lignes)
rng.Paste
'3eme tableau MARS
.Range("P1:S23").Copy
nb_lignes = .Range("P1:S23").Rows.Count
Set rng = rng.GoTo(What:=3, Which:=2, Count:=nb_lignes)
rng.Paste
'4eme tableau AVRIL
.Range("U1:X22").Copy
nb_lignes = .Range("U1:X22").Rows.Count
Set rng = rng.GoTo(What:=3, Which:=2, Count:=nb_lignes)
rng.Paste
'5eme tableau MAI
.Range("Z1:AC23").Copy
nb_lignes = .Range("Z1:AC23").Rows.Count
Set rng = rng.GoTo(What:=3, Which:=2, Count:=nb_lignes)
rng.Paste
'6eme tableau JUIN
.Range("AE1:AH27").Copy
nb_lignes = .Range("AE1:AH27").Rows.Count
Set rng = rng.GoTo(What:=3, Which:=2, Count:=nb_lignes)
rng.Paste
'7eme tableau JUILLET
.Range("F29:I50").Copy
nb_lignes = .Range("F29:I50").Rows.Count
Set rng = rng.GoTo(What:=3, Which:=2, Count:=nb_lignes)
rng.Paste
'8eme tableau AOUT
.Range("K29:N55").Copy
nb_lignes = .Range("K29:N55").Rows.Count
Set rng = rng.GoTo(What:=3, Which:=2, Count:=nb_lignes)
rng.Paste
'9eme tableau SEPTEMBRE
.Range("P29:S50").Copy
nb_lignes = .Range("P29:S50").Rows.Count
Set rng = rng.GoTo(What:=3, Which:=2, Count:=nb_lignes)
rng.Paste
'10eme tableau OCTOBRE
.Range("U29:X50").Copy
nb_lignes = .Range("U29:X50").Rows.Count
Set rng = rng.GoTo(What:=3, Which:=2, Count:=nb_lignes)
rng.Paste
'11eme tableau NOVEMBRE
.Range("Z29:AC55").Copy
nb_lignes = .Range("Z29:AC55").Rows.Count
Set rng = rng.GoTo(What:=3, Which:=2, Count:=nb_lignes)
rng.Paste
'12eme tableau DECEMBRE
.Range("AE29:AH55").Copy
nb_lignes = .Range("AE29:AH55").Rows.Count
Set rng = rng.GoTo(What:=3, Which:=2, Count:=nb_lignes)
rng.Paste
'insertion texte
'rng.InsertAfter "Tableau du mois de Janvier " & vbCrLf
'nb_lignes = nb_lignes + 1
'rng.InsertAfter "Tableau du mois de Fevrier" & vbCrLf
'nb_lignes = nb_lignes + 1
End With
'.HTMLBody = "<BODY><FONT face=Arial color=#000080 size=2></FONT>" & text1
.Display
'....... envoie le message
'.Send
If Err.Number <> 0 Then erreur = True
End With
'******************************************************************************************************************************
Kill Environ("Temp") & "\graph1.jpg"
Kill Environ("Temp") & "\graph2.jpg"
Kill Environ("Temp") & "\graph3.jpg"
Kill Environ("Temp") & "\graph4.jpg"
Kill Environ("Temp") & "\graph5.jpg"
Kill Environ("Temp") & "\graph6.jpg"
Kill Environ("Temp") & "\graph7.jpg"
Kill Environ("Temp") & "\graph8.jpg"
Kill Environ("Temp") & "\graph9.jpg"
Kill Environ("Temp") & "\graph10.jpg"
Kill Environ("Temp") & "\graph11.jpg"
Kill Environ("Temp") & "\graph12.jpg"
'Désassignation objets
Set olk = Nothing
Set email = Nothing
Set wdDoc = Nothing
End SubJ'aimerais aussi savoir a quoi correspond exactement cette ligne qui me pose problème:
Set rng = rng.GoTo(What:=3, Which:=2, Count:=nb_lignes)Maintenant afin de vous posez ma question j'ai effectuer des test qui enverrait par mail tous les tableau et tous les graphs:
Voici le résultat du premier Test:
Sur celui ci Aucun de mes tableaux ne s'est mis dans le corps du mail, géniale n'est ce pas.
Voici le second ou cette fois les tableaux se sont ajoutés:
Première erreur le mois d'Avril a disparu ....
Deuxième erreur a la fin du mois de Juillet des dossiers de Juin se sont ajoutés
3eme erreur a la fin du mois d'octobre des dossiers d'Aout se sont ajoutés.
Ces erreurs sont récurrents, mais ne sont jamais pour le même mois etc, ce qui est très compliqué pour réussir à identifier le problème ainsi que pour le corriger.
Voila, voici mon problème en esperant que l'un d'entre vous pourra m'aiguiller dans ma démarche, je ne suis pas un pro d'excel je débute encore et j'ai encore beaucoup à apprendre. :)
Cordialement