Macro Sur Excel

Bonjour,

Disposant d'un fichier de suivi de besoins sous excel,j'ai réalisé une macro (Visual Basic) qui permet à l'ensemble de l'équipe commercial / RH d'être informé par email (outlook) lorsque une modification est apporté à ce fichier : chacun reçois en émail "Modifications enregistrées dans le fichier suivi des demandes client 2015.xls"

voici la macro
Dim ol As Object, monmail As Object
DisplayAlerts = False
Set ol = CreateObject("outlook.application")
Set monmail = ol.CreateItem(olMailItem)
monmail.To = "emails équipe"
monmail.Subject = "suivi des demandes client 2015"
monmail.Body = "Modifications enregistrées dans le fichier suivi des demandes client 2015.xls"
monmail.Send
Set ol = Nothing
End Sub


Je souhaiterai en complément inclure dans l'émail reçu par chacun, les modifications qui ont été apportées

"Modifications enregistrées dans le fichier suivi des demandes client 2015.xls"
+
ligne complète du fichier et en GRAS ce qui a été modifié

Merci par avance de votre aide

3 réponses

  1. Modérateur
    Bonjour,

    Si ta macro est "totomatic", je suppose qu'elle est comprise dans un événement de la feuille ou du classeur. Peux tu nous dire lequel et/ou copier/coller le code dans sa globalité, y compris le "type" de Sub. Exemple :
    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim ol As Object, monmail As Object
    DisplayAlerts = False
    Set ol = CreateObject("outlook.application")
    Set monmail = ol.CreateItem(olMailItem)
    monmail.To = "emails équipe"
    monmail.Subject = "suivi des demandes client 2015"
    monmail.Body = "Modifications enregistrées dans le fichier suivi des demandes client 2015.xls"
    monmail.Send
    Set ol = Nothing
    End Sub


    1. Contributeur
      Bonjour,

      Voici un exemple pour détecter les cellules qui ont été modifiées et les colorier en rouge.

      Les données sont dans la feuille1, les cellules modifiées sont dans la feuille2, c'est a adapter:

      Mettre dans la feuille 1:

      Option Explicit
      Private Sub Worksheet_SelectionChange(ByVal Target As Range)
      Dim cel As Range
      For Each cel In Target
      Worksheets("Feuil2").Range(cel.Address) = 1
      Next cel
      End Sub
      


      Inserer une UserForm avec 2 boutons et mettre ce code:

      Option Explicit
      Private Sub CommandButton1_Click()
      WorkbookFind
      End Sub
      Sub WorkbookFind()
      Dim What, FirstAddress, sht, found
       What = "1"
        If What = "" Then Exit Sub
        For Each sht In Worksheets
          sht.Activate
          Set found = sht.Cells.Find(What)
          If Not found Is Nothing Then
            FirstAddress = found.Address
            Do
              found.Activate
           Sheets("Feuil1").Range(found.Address).Font.Color = RGB(255, 0, 0)
        Set found = Cells.FindNext(After:=ActiveCell)
              If found.Address = FirstAddress Then Exit Do
            Loop
          End If
        Next sht
      End Sub
      Private Sub CommandButton2_Click()
      Retablir
      Sheets("Feuil2").Cells.Clear
      End Sub
      Sub Retablir()
      Dim What, FirstAddress, sht, found
       What = "1"
        If What = "" Then Exit Sub
        For Each sht In Worksheets
          sht.Activate
          Set found = sht.Cells.Find(What)
          If Not found Is Nothing Then
            FirstAddress = found.Address
            Do
              found.Activate
           Sheets("Feuil1").Range(found.Address).Font.Color = RGB(0, 0, 0)
        Set found = Cells.FindNext(After:=ActiveCell)
              If found.Address = FirstAddress Then Exit Do
            Loop
          End If
        Next sht
      End Sub
      Private Sub UserForm_Initialize()
      CommandButton1.Caption = "Rechercher"
      CommandButton1.Caption = "Rétablir"
      End Sub
      


      Il suffit donc d'envoyer la feuille par e-mail et de rétablir

      Amitiés a Pijaku

      1. Contributeur
        Petite erreur d'évènement feuille:

        Option Explicit
        Private Sub Worksheet_Change(ByVal Target As Range)
        Dim cel As Range
        For Each cel In Target
        Worksheets("Feuil2").Range(cel.Address) = 1 'a adapter
        Next cel
        End Sub