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 : Sélectionner tout - Visualiser dans une fenêtre à part
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.