Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Workbook_SheetChange Sh, Sh.[A1] 'lance la macro
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim F As Worksheet, c As Range, i As Variant, o As Object
Set F = Sheets("Images")
If Sh.Name = F.Name Then Exit Sub
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
On Error Resume Next 'si aucune SpecialCell
Sh.DrawingObjects.Visible = False 'masque les objets existants
With Sh.UsedRange.Offset(3)
.Value = .Value 'supprime les formules de liaison
.Replace 0, "", xlWhole 'supprime les zéros
For Each c In .SpecialCells(xlCellTypeConstants)
If c.Column Mod 4 = 0 Then
i = Application.Match(c, F.Columns(1), 0)
If IsNumeric(i) Then
For Each o In F.DrawingObjects
If o.TopLeftCell.Address = F.Cells(i, 2).Address Then
o.Copy
Sh.Paste
Selection.Left = c(1, 2).Left + (c(1, 2).Width - Selection.Width) / 2
Selection.Top = c(1, 2).Top + (c(1, 2).Height - Selection.Height) / 2
Exit For
End If
Next o
End If
End If
Next c
End With
ActiveCell.Activate
Application.EnableEvents = True 'réactive les évènements
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim w As Worksheet, o As Object
On Error Resume Next
For Each w In Worksheets
For Each o In w.DrawingObjects
If o.Visible Then Else o.Delete
Next o, w
Application.OnTime 1, Me.CodeName & ".Sauvegarde" 'enregistrement différé
End Sub
Sub Sauvegarde()
Application.EnableEvents = False 'désactive les évènements
Me.Save
Application.EnableEvents = True 'réactive les évènements
End Sub
