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
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
| Sub envoiemailXLS()
'
' envoiemail Macro
Dim Chemin As String, Fichier As String
Dim NewSheet As Worksheet
Dim SujetMail As String
Dim CorpsMessage As String
'le fichier est sélectionné
With ThisWorkbook.Sheets("PREPA")
Chemin = ThisWorkbook.Path
Fichier = Chemin & "\" & "fiche-prépa" & .Range("A3") & ".xls" 'Attention au "." devant Range
'On copie la feuille dans un nouveau classeur
.Copy
'On pointe la nouvelle feuille (et implicitement le classeur qui la contient)
Set NewSheet = ActiveSheet
End With
With NewSheet
'Supprimer la protection de la feuille
.Unprotect Password:="xxxxx"
'On écrase les formules
.Range("A1:F50").Copy
.PasteSpecial xlPasteValues
.CutCopyMode = False
'reactiver la protection de la feuille
.Protect Password:="xxxxx", DrawingObjects:=True, Contents:=True, Scenarios:=True
'?? vraiment utile? jusqu'ici la selection de l'utilisateur au départ n'a pas changée. A toi de voir
'.Range("E19:F19").Select
'On enregistre le document
'On désactive les alertes pour ne pas avoir de message en cas de fichier déjà présent.
'Excel écrasera un éventuel fihcier déjà présent sans nous demander (attention donc ;) )
Application.DisplayAlerts = False
.Workbook.SaveAs Fichier
Application.DisplayAlerts = True
'On prépare le sujet du mail
SujetMail = "Fiche Prépa pour " & .Range("C2")
CorpsMessage = "Bonjour," & Chr(13) & Chr(13) & "Veuillez trouver, ci-joint, la fiche prépa " & .Range("C2").Value & ". " & Chr(13) & Chr(13) & "Bonne réception."
End With
'message pour prévenir que les infos noté dans le fichier sont prête à être envoyées
MsgBox "La fiche est prêt à être envoyé.", vbOKCancel, "Création du mail?"
'on prépare pour l'envoie du mail et on fait appel à l'app de messagerie, avec les destinataire, le sujet, le corp du message et le fichier joint
CreationMail SujetMail, CorpsMessage, Fichier
End Sub
Sub envoiemailPDF()
'
' envoiemail Macro
Dim Chemin As String, Fichier As String
Dim PDFFile As String
Dim SujetMail As String
Dim CorpsMessage As String
With ThisWorkbook.Sheets("PREPA")
Chemin = ThisWorkbook.Path
Fichier = Chemin & "\" & "fiche-prépa" & Range("A3") & ".pdf" 'Attention à l'extension et au "." devant Range
'On prépart le PDF
.ExportAsFixedFormat xlTypePDF, Fichier, xlQualityStandard, False, False, False
'On prépare le sujet du mail
SujetMail = "Fiche Prépa pour " & .Range("C2").Value
CorpsMessage = "Bonjour," & Chr(13) & Chr(13) & "Veuillez trouver, ci-joint, la fiche prépa " & .Range("C2").Value & ". " & Chr(13) & Chr(13) & "Bonne réception."
End With
MsgBox "La fiche est prêt à être envoyé.", vbOKCancel, "Création du mail?"
'On ouvre le mail
CreationMail SujetMail, CorpsMessage, Fichier
End Sub
Sub CreationMail(SujetMail As String, CorpsMessage As String, Optional CheminPJ As String)
Dim MonOutlook As Object
Dim MonMessage As Object
Set MonOutlook = CreateObject("Outlook.Application")
Set MonMessage = MonOutlook.CreateItem(0)
MonMessage.To = ""
MonMessage.Cc = ""
MonMessage.Subject = SujetMail
MonMessage.body = CorpsMessage
MonMessage.Attachments.Add CheminPJ
MonMessage.display
Set MonOutlook = Nothing
End Sub |
Ajout d'une feuille active par mail
Répondre avec citation
. Si ce message est résolu, cliquez sur 
.
Tutoriel : 
Envoyé par jerome.vaussenat
Partager