'### Constantes à adapter ###
Const LARGEUR As Double = 140
Const HAUTEUR As Double = 100
Const CELLULE_BASE = "D1"
'#############################
Sub EgaliseLesPhotos()
Dim S As Worksheet
Dim PICT As Picture
Dim x#
Dim i&
Dim myTOP&
Set S = ActiveSheet
For i& = 1 To 2 'on traite 2 fois pour affinage
myTOP& = S.Range(CELLULE_BASE).Top
For Each PICT In S.Pictures
With PICT
.Top = myTOP&
.Left = S.Range(CELLULE_BASE).Left
.Width = LARGEUR
.Height = HAUTEUR
myTOP& = myTOP& + .Height 'nouvelle position verticale
x# = 1
If .Width < LARGEUR Then
Do
.ShapeRange.ScaleWidth x#, msoFalse, msoScaleFromTopLeft
x# = x# + 0.01
Loop Until .Width >= LARGEUR
ElseIf .Width > LARGEUR Then
Do
.ShapeRange.ScaleWidth x#, msoFalse, msoScaleFromTopLeft
x# = x# - 0.01
Loop Until .Width <= LARGEUR
End If
End With
Next PICT
Next i&
End Sub