Commentaires dynamiques

Sub AjouteCommentaire()
    Dim Cellule As Range
    Dim ws As Worksheet
    
    Set ws = Sheets("feuil1")

    For Each Cellule In ws.Range("A1:A" & ws.Range("B65536").End(xlUp).Row)
        If Not Cellule.Comment Is Nothing Then
            Cellule.Comment.Delete
        End If
        
        If Cellule.Offset(, 1).Value <> "" Then
            Cellule.AddComment Cellule.Offset(, 1).Value
        End If
    Next Cellule
End Sub

Sub envoi_Feuille()
  répertoireAppli = ActiveWorkbook.Path
  Sheets("résultats").Copy
  Application.DisplayAlerts = False
  ActiveWorkbook.SaveAs répertoireAppli & "\Resultats.xls"
  ActiveWindow.Close
  '--- Envoi par mail
  Dim olapp As Outlook.Application
  Sheets("destinataires").Select
  Range("A11").Select
  Do While Not IsEmpty(ActiveCell)
     Dim msg As MailItem
     Set olapp = New Outlook.Application
     Set msg = olapp.CreateItem(olMailItem)
     msg.To = ActiveCell.Value
     msg.Subject = Range("A2").Value
     msg.Body = Range("A5").Value & Chr(13) & Chr(13) & Range("A8").Value & Chr(13) & Chr(13)
     msg.Attachments.Add Source:=répertoireAppli & "\Resultats.xls"
     msg.Send
     ActiveCell.Offset(1, 0).Select
  Loop
End Sub

Sub envoi_PJ()
    ChDir ActiveWorkbook.Path
    répertoireAppli = ActiveWorkbook.Path   ' Penser à Outils/Références Outlook
    '---  Envoi par mail
    Dim olapp As Outlook.Application
    Sheets("destinataires").Select
    [A11].Select
    Do While Not IsEmpty(ActiveCell)
      MsgTo = MsgTo & ActiveCell & ";"
      ActiveCell.Offset(1, 0).Select
    Loop
    Dim msg As MailItem
    Set olapp = New Outlook.Application
    Set msg = olapp.CreateItem(olMailItem)
    msg.To = MsgTo
    msg.Subject = [A2]
    msg.Body = [A5] & Chr(13) & Chr(13) & [A8].Value & Chr(13) & Chr(13)
    '-- pj
    [C8].Select
    Do While Not IsEmpty(ActiveCell)
      nf = ActiveWorkbook.Path & "\" & ActiveCell.Value
      msg.Attachments.Add Source:=nf
      ActiveCell.Offset(1, 0).Select
    Loop
    msg.Send
End Sub