Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Range("ac15,ad15,z16,u15,w15,y15"), Target) Is Nothing Then
ActiveWindow.Zoom = 100
[A13].Select
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Range("ac15,ad15,z16,u15,w15,y15"), Target) Is Nothing Then
ActiveWindow.Zoom = 300
Application.Goto Target, Scroll:=True
SendKeys "%{down}"
Else
ActiveWindow.Zoom = 100
End If
Dim image, a, c, nomimage, répertoire
'----
If Left(Target.Address, 5) = "$D$15" Then
répertoire = "c:\photos" ' adapter
image = Range("C23").Value & ".jpg"
nomimage = image
Set c = Target
With ActiveSheet
On Error Resume Next
.Pictures.Insert(répertoire & "\" & nomimage).Name = nomimage
If Err = 0 Then
.Shapes(nomimage).Height = c.Height
.Shapes(nomimage).Left = c.Left + (c.Width - .Shapes(nomimage).Width) / 2
.Shapes(nomimage).Top = c.Top
.Shapes(nomimage).LockAspectRatio = msoTrue
End If
End With
End If
End Sub