Sub Insert_Me()
Dim Target, T
Dim S As Range: Set S = ActiveCell
If S.Column = Columns("J").Column And S.Row > 2 Then
S.RowHeight = 57: S.ColumnWidth = 10
With Application.FileDialog(msoFileDialogFilePicker)
.InitialView = msoFileDialogViewTiles
.InitialFileName = Getpath(&H27) & "\*.jpg"
.AllowMultiSelect = False
.Filters.Clear
.Filters.Add "Fichiers Photos", "*.jpg;*.jpeg"
.Title = "Sélection d'une photo "
.ButtonName = "Insérer"
If .Show Then
Target = .SelectedItems(1)
S.Select
With ActiveSheet.Pictures.Insert(Target)
.Name = Target
.Placement = xlMoveAndSize
.ShapeRange.LockAspectRatio = msoFalse
.Height = S.Height
.Width = S.Width
End With
T = InputBox("Entrez le nom explicite de la photo", "Description Photo", Target)
With S.Offset(, 1)
.Value = IIf(T = "", Target, T)
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Font.Bold = False
.Font.Name = "Calibri"
.Font.Size = 11
End With
End If
End With
Else
MsgBox "Vous n'êtes pas en colonne J", vbCritical
End If
End Sub