Créer un fichier Excel et l'envoyer par mail (vba)
Bonjour,
Je suis débutante en VBA. Et j'arrive pas résoudre ce problème.
J'ai une base de données dans un fichier Excel. Chaque ligne de cette base de données est différente et elle est attribuée à une adresse mail.
J'aimerais créer pour chaque ligne un nouveau fichier Excel avec ses valeurs et y créer un camembert correspondant aux valeurs copiés puis envoyer ce fichier au mail correspondant.
Voila ce que j'ai essayé. J'ai récupéré des bouts de codes et j'ai utilisé l'enregistreur de macro.
Ce code me permet de créer à chaque fois un nouveau fichier, il recopie les valeurs d'une ligne et créer le camembert correspondant et ainsi de suite pour chaque ligne. Or je ne sais pas comment envoyer ce fichier créée au mail correspondant.
J'espère que je suis claire.
Code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
|
Sub macro()
Dim graphique As ChartObject
Application.ScreenUpdating = False
For i = 2 To 3
ThisWorkbook.Sheets("Base de données").Range("A" & i & ":E" & i).Copy
'créer un nouveau classeur et y coller les données
Set nouv = Workbooks.Add
Set pg = nouv.Sheets(1)
pg.Paste
pg.Cells(1).PasteSpecial Paste:=xlValues
ActiveSheet.Shapes.AddChart.Select
ActiveChart.ChartType = xl3DPie
ActiveChart.SetSourceData Source:=Range("C1:E2")
ActiveChart.SeriesCollection(1).XValues = "='Base de données'!$C$1:$E$1"
ActiveChart.SeriesCollection(1).Name = "Répartition du temps"
ActiveChart.HasLegend = True
ActiveChart.HasTitle = True
ActiveChart.ApplyDataLabels AutoText:=True, LegendKey:=False, _
HasLeaderLines:=True, ShowSeriesName:=False, ShowCategoryName:=False, _
ShowValue:=False, ShowPercentage:=True, ShowBubbleSize:=False
'faire le ménage
Set pg = Nothing
Set gr = Nothing
Set nouv = Nothing
Application.CutCopyMode = False
Next i
End Sub |
Je connais le code pour envoyer un fichier se trouvant sur mon ordinateur. Mais je ne sais pas comment y insérer ces nouveaux fichiers crées et les envoyer aux mails correspondants.
Code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
|
Sub Envoyer_Mail_Outlook()
Dim ObjOutlook As New Outlook.Application
Dim oBjMail
Dim Nom_Fichier As String
Dim adresse As String
' adresses emails
For i = 2 To 3
'pour chaque adresse on démarre l’opération
adresse = Range("B" & i)
Set ObjOutlook = New Outlook.Application
Set oBjMail = ObjOutlook.CreateItem(olMailItem)
Nom_Fichier = "C:\Users\"
If Nom_Fichier = "" Then Exit Sub
'---------------------------------------------------------
With oBjMail
' l'objet du mail
.Subject = "Réponses questionnaire"
'le corps du mail ..son contenu
.Body = "Ci-joint les réponses aux questionnaires"
.Attachments.Add Nom_Fichier
.To = adresse
' Ici on peut supprimer pour l'envoyer sans vérification
.Display
.Send
End With
Set oBjMail = Nothing
Set ObjOutlook = Nothing
Next i
End Sub |
Je vous remercie pour votre aide ! :)
