Code VBA envoi mail automatique si modification feuille Excel d'un classeur

Bonjour à tous, et merci d'avance

J'ai le code ci-dessous mais je n'arrive pas à le faire fonctionner. Je souhaiterai que ce code me sert lorsqu'une modification est apporter à une feuille nommé "MES AVI 2024", qu'un mail automatique est envoyé à mon adresse mail pour signifier qu'une modification à été apporter à ma feuille "MES AVI 2024" tout en indiquant les modifications apporté dans le corps du mail. je souhaiterai dans la mesure du possible que cette macro soit exécuté uniquement lorsque le fichier est enregistré soit par le bouton "ENREGISTRER" du fichier, soit lorsqu'on ferme le fichier et que l'on nous propose d'enregistrer ou d'annuler ET que l'on clique sur enregistrer.

Je vous joint un fichier exemple ci-dessous

Merci beaucoup pour votre aide!

Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws As Worksheet
Dim cell As Range
Dim lastRow As Long
Dim mailBody As String
Dim OutlookApp As Object
Dim OutlookMail As Object

' Vérifier si la modification a été faite dans la feuille "MES AVI 2024"
Set ws = ThisWorkbook.Sheets("MES AVI 2024")
If Not Intersect(Target, ws.UsedRange) Is Nothing Then
' Construire le corps du mail avec la liste des modifications
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
For Each cell In Target
If Not Application.Intersect(cell, ws.Columns("A")) Is Nothing Then
mailBody = mailBody & "Cellule modifiée: " & cell.Address & vbCrLf
mailBody = mailBody & "Ancienne valeur: " & cell.Value & vbCrLf
mailBody = mailBody & "Nouvelle valeur: " & cell.Value & vbCrLf & vbCrLf
End If
Next cell

' Envoyer l'e-mail
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(0)

With OutlookMail
.To = "exemple@mail.com"
.Subject = "Alerte de modification sur la feuille MES AVI 2024"
.Body = mailBody
.Send
End With

Set OutlookMail = Nothing
Set OutlookApp = Nothing
End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws As Worksheet
Dim cell As Range
Dim lastRow As Long
Dim mailBody As String
Dim OutlookApp As Object
Dim OutlookMail As Object

' Vérifier si la modification a été faite dans la feuille "MES AVI 2024"
Set ws = ThisWorkbook.Sheets("MES AVI 2024")
If Not Intersect(Target, ws.UsedRange) Is Nothing Then
' Construire le corps du mail avec la liste des modifications
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
For Each cell In Target
If Not Application.Intersect(cell, ws.Columns("A")) Is Nothing Then
mailBody = mailBody & "Cellule modifiée: " & cell.Address & vbCrLf
mailBody = mailBody & "Ancienne valeur: " & cell.Value & vbCrLf
mailBody = mailBody & "Nouvelle valeur: " & cell.Value & vbCrLf & vbCrLf
End If
Next cell

' Envoyer l'e-mail
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(0)

With OutlookMail
.To = "exemple@mail.com"
.Subject = "Alerte de modification sur la feuille MES AVI 2024"
.Body = mailBody
.Send
End With

Set OutlookMail = Nothing
Set OutlookApp = Nothing
End If
End Sub

Edit Modo : merci d'utiliser les balises de code en cliquant sur l'icone </> dans la barre de menu lorsque vous postez un code

Bonjour,

Tu as dû oublier de joindre le fichier.
Pour ta demande ça va sans doute etre compliqué de te faire un recap de ce qui a été changé entre l'ouverture et l'enregistrement mais je veux bien essayer.

Bonjour effectivement je n'ai pas mis la Pj. La voici!

En fait c'est pas un recap mot pour mot que je voudrais, je souhaiterai en réalité dans le corp du mail que ça soit écrit la cellule de la colonne A de la ligne qui a été modifié. Par exemple, si j'ai une modification dans la ligne 5, je voudrais que une copie d'écran de la ligne du tableau objet de la modification soit inséré au mail par exemple une cellule de la ligne 5 modifié, une capture des cellule A5 à C5 soit collé au mail(mon tableau se finit en C)

Pour information, j'utilise outlook

J'espère avoir été assez clair.... Merci d'avance

Bonjour,

Une proposition :

Dans la partie "Sub Workbook_BeforeSave", il faudra changer .Display en .Send

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'...

        If MaxLigne > 2 Then .Display

'...
End Sub

L'envoi de mail se fait à l'enregistrement du fichier seulement si il y a un changement entre le moment de l'ouverture du fichier et son enregistrement.

A chaque enregistrement, on fait une mise a jour des changements (dans une feuille masquée) ce qui t'éviteras de recevoir 50 mails d'un utilisateur acharné du clic "enregistrer".

A+

Je te remercie beaucoup de m'accorder de ton temps j'essaie cela dès demain matin. Si je comprend bien, le mail sera envoyé automatiquement dès que le fichier sera enregistré?