Macro envoi par e-mail de la liste des modifications
Bonjour à tous,
La solution ne sera peut-être pas bien compliquée mais je ne suis pas très dégourdi en VBA et je n'ai pas réussi à trouver de discussion qui correspondent complètement à mon problème.
J'ai récupéré dans une ancienne discussion sur le forum le code suivant qui permet d'envoyer un e-mail lorsqu'une modification est effectuée sur une plage donnée de ma feuille.
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
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
| Private Sub Worksheet_Change(ByVal Target As Range)
Const destinataire = "destinataire@adresse.com"
'ci-dessous on définie la zone à surveiller "A4:AB50"
If Intersect(Range("A4:AB50"), Target) Is Nothing Then Exit Sub
If Target.Cells.Count > 1 Then Exit Sub
'Si on est dans la zone on crée un Email
If MsgBox("Voulez-vous valider ce changement ?", vbYesNo, "Envoi Email") = vbYes Then
Const olMailItem = 0
'Open a new mail item
Dim outlookApp As Object
Set outlookApp = CreateObject("Outlook.Application")
Dim outMail As Object
Set outMail = outlookApp.CreateItem(olMailItem)
outMail.To = destinataire
outMail.Subject = "Modifs dans le classeur " & ActiveWorkbook.Name
'Get its Word editor
outMail.Display
Dim wordDoc As Object
Set wordDoc = outMail.GetInspector.WordEditor
Const wdStory = 6
Const wdParagraph = 4
'Range([a1], [p1].SpecialCells(xlLastCell)).Select
'ci-dessous je copie mes lignes de titres dans l'email en créant une feuille temporaire
Set ws_tempo = Workbooks.Add.ActiveSheet
Range("A1:AB3").Copy ws_tempo.Range("a1")
Target.EntireRow.Range("a1:ab1").Copy ws_tempo.Range("A4")
'copie des largeurs de colonnes
Target.Parent.Range("A1:AB5").Copy
ws_tempo.Range(ws_tempo.Range("A1"), ws_tempo.Range("A1").SpecialCells(xlLastCell)).PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
ws_tempo.Range(ws_tempo.Range("A1"), ws_tempo.Range("A1").SpecialCells(xlLastCell)).Copy
'Pour coller dans l'Email en écrasant tout
'wordDoc.Range.PasteExcelTable LinkedToExcel:=False, WordFormatting:=False, RTF:=False
'ci-dessous je copie ma ligne modifiée dans l'email au début en conservant la signature
Set objSel = wordDoc.Windows(1).Selection
objSel.Move wdStory, -1
objSel.Move wdParagraph, 1
'je colle
objSel.PasteExcelTable LinkedToExcel:=False, WordFormatting:=False, RTF:=False
'Pour envoyer le Mail décommentez
'outMail.send
Target.Copy
ws_tempo.Parent.Close SaveChanges:=False
'enregistrement du fichier
ActiveWorkbook.Save
End If
End Sub |
La macro récupère la ligne complète qui contient une modification et la colle dans un e-mail.
Jusque là tout va bien, le seul hic est que cela se lance à chaque fois que je réalise la moindre manipulation sur la feuille. Ce qui n'est clairement pas pratique.
Avez-vous une idée du code qu'il faudrait que j'utilise en plus, ou de la modif que je dois appliquer à mon code actuel pour pouvoir envoyer la liste complète des modifications en une seule fois ?
Et ceci uniquement lorsque je veux sauvegarder le fichier avant sa fermeture et non à chaque fois que je fais une nouvelle saisie ?
Merci par avance pour votre aide.
Cordialement.
