Excel envoi Email en code VBA

Bonjour tout le monde.

Plusieurs collaborateurs travaillent en partage sur un fichier Excel et peuvent modifier en fonctions des éléments imprévus les dates de la colonne "Prise en charge " et mon chef souhaiterais être avisé par email si une date de cette colonne vient d'être modifié.

Inutile de vous préciser qu'en VBA, je n' y connais pratiquement rien.

Merci à tous.

Cordialement.

Bonjour,

Je ne suis pas sûr que les macros fonctionnent en mode classeur partagé, je ne sui pas dans un tel environnement. Sinon, quelle est l'adresse de la première date de la colonne "Prise en charge" ?

Daniel

Je ne comprends pas très bien ta demande mais il s'agit tout simplement que si un collaborateur modifie la date en colonne "Prise en charge", un email soit envoyé.

La colonne est la colonne "H4 et jusqu'a "H11" et dans la feuille "Données 2023".

Merci par avance et si ce n'est pas possible...tant pis.

Gérard.

Bonjour,

Voici un code qui ne vient pas de moi mais qui peut t'être utile.

Private Sub Worksheet_Change(ByVal Target As Range)
'Updated by Extendoffice 2017/9/12
'
' ---------------------------------------------------------
'
'
'       Permet d'envoyer un mail quand une cellule xRg est modifié
 '
  '
   ' ---------------------------------------------------------------------
    '
    ' A COPIER DANS "CLIQUE DROIT" sur l'onglet de la page puis "Visualiser le code"
    '
    Dim xRgSel As Range
    Dim xOutApp As Object
    Dim xMailItem As Object
    Dim xMailBody As String
    On Error Resume Next
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set xRg = Range("A2:E11")  <-- A modifier selon vos envies
    Set xRgSel = Intersect(Target, xRg)
    ActiveWorkbook.Save
    If Not xRgSel Is Nothing Then
        Set xOutApp = CreateObject("Outlook.Application")
        Set xMailItem = xOutApp.CreateItem(0)
        xMailBody = "Cell(s) " & xRgSel.Address(False, False) & _
            " in the worksheet '" & Me.Name & "' were modified on " & _
            Format$(Now, "mm/dd/yyyy") & " at " & Format$(Now, "hh:mm:ss") & _
            " by " & Environ$("username") & "."

        With xMailItem
            .To = "Email Adress"
            .Subject = "Worksheet modified in " & ThisWorkbook.FullName
            .Body = xMailBody
            .Attachments.Add (ThisWorkbook.FullName)
            .Display
        End With
        Set xRgSel = Nothing
        Set xOutApp = Nothing
        Set xMailItem = Nothing
    End If
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

Modifier le xRg selon tes pré-requis.

Cette procédure envoi un mail ainsi qu'une copie du classeur via l'application Outlook dès que "xRg" est modifié.

@+

Fais un clic droit sur l'onglet de la feuille et un clic sur "Visualiser le code". Colle le code suivant dans la partie droite après avoir remplacé les chaînes Subject,, Body et recipients :

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim olApp As Object, M As Object, C As Range
  If Intersect(Target, Range("H4:H11")) Is Nothing Then Exit Sub
  If Target.Value = "" Or Target.Count > 1 Then Exit Sub
  Set olApp = CreateObject("Outlook.application")
  Set M = olApp.CreateItem(olMailItem)
  With M
    .Subject = "Subject"
    .Body = "Body"
    .Recipients.Add "test@test.com"
    .Send
  End With
End Sub

Ok,

Merci à vous deux.

Je vais tester.

Bonne fin de journée.

Cdt