Private Sub Worksheet_Activate()
Dim execution As Byte, c As Range, f As String
Application.ScreenUpdating = False
For execution = 1 To 2
For Each c In IIf(execution = 1, [D12:O12], [D21:O21])
f = c.Formula
f = IIf(execution = 1, Replace(f, "A7", Me.Name & "!A$7"), Replace(f, "A16", Me.Name & "!A$16"))
f = Replace(Replace(Replace(Replace(f, "$A:$A", "A2"), "$B:$B", "B2"), "$C:$C", "C2"), "$D:$D", "D2")
f = Replace(Replace(Replace(Replace(f, "A:A", "A2"), "B:B", "B2"), "C:C", "C2"), "D:D", "D2") 'si références relatives
With Sheets("BDD").[A1].CurrentRegion 'nom de la feuille à adapter
.Cells(2, .Columns.Count + 2) = f 'critère de filtrage en F2
.AdvancedFilter xlFilterInPlace, .Cells(1, .Columns.Count + 2).Resize(2)
InsereImage .Cells, c
If .Parent.FilterMode Then .Parent.ShowAllData 'RAZ
End With
Next c, execution
End Sub
Sub InsereImage(plage As Range, cel As Range)
plage.CopyPicture
With plage.Parent.ChartObjects.Add(0, 0, plage.Width, plage.Height).Chart
.Paste
.Export ThisWorkbook.Path & "\MonImage.gif", "GIF"
.Parent.Delete 'supprime le graphique temporaire
End With
cel.ClearComments
With cel.AddComment("").Shape
.Width = plage.Width
.Height = plage.Height
.Fill.UserPicture ThisWorkbook.Path & "\MonImage.gif"
End With
Kill ThisWorkbook.Path & "\MonImage.gif" 'supprime le fichier gif
End Sub