EXCEL - Astuce sur CCM interessante!

Sub CopierGraph()
    Dim sChemin As String
    Dim sNomGraphique As String
    Dim rPlageDeDonnees As Range
    Dim rCelluleACommenter As Range
    
    On Error GoTo SupprimerCommentaire
    'On crée une feuille qui servira à stocker le nom du dernier fichier
    
    If Worksheets(1).Name <> "DernierFichier" Then
        Worksheets(1).Select
        Sheets.Add
        Worksheets(1).Name = "DernierFichier"
        Sheets("DernierFichier").Select
        ActiveWindow.SelectedSheets.Visible = False
        Sheets("DernierFichier").Range("A1").Value = 1
    End If
    
    'Crée le fichier MonGraphx.BMP
    sChemin = ThisWorkbook.Path + "\MonGraph" & Sheets("DernierFichier").Range("A1").Value & ".GIF"
    
    'Selection des cellules
    Set rPlageDeDonnees = Application.InputBox("Saisissez la plage de données nécessaires au graphique", Type:=8)
    Set rCelluleACommenter = Application.InputBox("Indiquez la cellule à commenter", Type:=8)
        
    'On crée le graphique
    Charts.Add
    With ActiveChart
        sNomGraphique = .Name
            'Histogramme (Le type de graphique se trouve dans CharType)
            'On pourra ajouter un UserForm pour sélectionner le type de graphique
        .ChartType = xlColumnClustered
        .SetSourceData Source:=rPlageDeDonnees, PlotBy:=xlColumns
        'On exporte le graphique
        .Export Filename:=sChemin, Filtername:="GIF"
    End With
    
    
    'On supprime le graphique sans msg de confirmation
    Application.DisplayAlerts = False
    Sheets(sNomGraphique).Delete
    Application.DisplayAlerts = True
    
    'On ajoute le commentaire
    With Worksheets(rCelluleACommenter.Worksheet.Index).Range(rCelluleACommenter.Address)
        .AddComment "Le graphique correspondant à la plage est"
        .Comment.Shape.Height = 400
        .Comment.Shape.Width = 500
        .Comment.Shape.Fill.UserPicture (sChemin)
    End With
        
    If MsgBox("Voulez vous effacer le fichier image ?", vbYesNo + vbQuestion) = vbYes Then
        Kill sChemin
    Else
        Sheets("DernierFichier").Range("A1").Value = Sheets("DernierFichier").Range("A1").Value + 1
    End If
    
    Exit Sub

SupprimerCommentaire:
    If Err.Number = 1004 Then
        'On supprime le commentaire existant car AddComment a provoqué une erreur
       Worksheets(rCelluleACommenter.Worksheet.Index).Range(rCelluleACommenter.Address).Comment.Delete
       Resume
    End If
End Sub