Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim lig&, col&
lig = Target.Row: col = Target.Column
If lig > Range("ee570").Row Or col > Range("ee570").Column Then Exit Sub
If (col - Range("g6").Column) Mod (Range("o6").Column - Range("g6").Column) <> 0 Then Exit Sub
If (lig - Range("g6").Row) Mod (Range("g18").Row - Range("g6").Row) <> 0 Then Exit Sub
cancel = True
InsererImage Target(1, 1)
End Sub
Sub InsererImage(xrg As Range)
' Macro & instructions pour coller une photo et le nom de celle-ci
Dim zz As String, g As String, xx As String
Dim myPicture As Object
Dim d As Byte, aux
On Error GoTo 1
Application.DisplayAlerts = False
aa = Application.GetOpenFilename
If aa = False Then Exit Sub
zz = Dir(aa)
d = Len(zz)
Do Until g = "."
g = Mid(zz, d, 1)
d = d - 1
Loop
xx = Left(zz, Len(zz) - (Len(zz) - d))
xrg.Offset(1) = xx
Set myPicture = ActiveSheet.Pictures.Insert(aa)
myPicture.OnAction = "Agrandissement_Image"
myPicture.ShapeRange.AlternativeText = "zoom"
With myPicture.ShapeRange
.Left = xrg.Left
.Top = xrg.Top
.Fill.Visible = msoTrue
.Fill.Solid
.Fill.ForeColor.RGB = RGB(255, 255, 255)
.Fill.Transparency = 0#
.Line.Weight = 0.75
.Line.DashStyle = msoLineSolid
.Line.Style = msoLineSingle
.Line.Transparency = 0#
.Line.Visible = msoTrue
.Line.ForeColor.SchemeColor = 64
.Line.BackColor.RGB = RGB(255, 255, 255)
.LockAspectRatio = msoTrue
.Height = xrg.Resize(9).Height
If .Width > xrg.Resize(, 2).Width Then .Width = xrg.Resize(, 2).Width
.Rotation = 0#
End With
Application.DisplayAlerts = True
End
1
On Error GoTo 0
Application.DisplayAlerts = True
End Sub