Agrandir photos

Sub ChangeDimensions()
ThisWorkbook.Names.Add "K", IIf([K] = 2, 0.5, 2)
Nom = Application.Caller
With ActiveSheet.Shapes(Nom)
.Width = [K] * .Width
.Height = [K] * .Height
End With
End Sub

Sub AffecterMacro() 'peut se lancer par Ctrl+A
Dim s As Shape
For Each s In ActiveSheet.Shapes
s.OnAction = "ChangeDimensions"
Next
End Sub

Sub ChangeDimensions()
Dim Nom$, coef As Double
On Error Resume Next
Nom = "X" & Application.Caller 'les noms doivent commencer par une lettre...
coef = Mid(ThisWorkbook.Names(Nom), 2, 20) 'élimine le caractère =
If Err Then coef = 2 Else coef = 1 / coef 'coef 2 pour l'agrandissement
ThisWorkbook.Names.Add Nom, coef
With ActiveSheet.Shapes(Application.Caller)
.Width = .Width * coef
.Height = .Height * coef
End With
End Sub

Sub ChangeDimensions()
Dim Nom$, coef As [COLOR="Red"]Variant[/COLOR]
On Error Resume Next
Nom = "X" & Application.Caller 'les noms doivent commencer par une lettre...
[COLOR="Red"]coef = Evaluate(Nom)[/COLOR]
If [COLOR="Red"]IsError(coef)[/COLOR] Then coef = [COLOR="Red"][B]1.8[/B][/COLOR] Else coef = 1 / coef 'coef 1,8 pour l'agrandissement
ThisWorkbook.Names.Add Nom, coef
With ActiveSheet.Shapes(Application.Caller)
.Width = .Width * coef
.Height = .Height * coef
End With
Application.OnRepeat "", "" 'évite "Répéter Macros" menu Edition
End Sub

Sub ChangeDimensions()
Dim Nom$, coef As Variant
On Error Resume Next
Nom = "X" & Application.Caller 'les noms doivent commencer par une lettre...
coef = Evaluate(Nom)
If IsError(coef) Then coef = [COLOR="Red"]3.5[/COLOR] Else coef = 1 / coef 'coef 3,5 pour l'agrandissement
ThisWorkbook.Names.Add Nom, coef
With ActiveSheet.Shapes(Application.Caller)
[COLOR="Red"].LockAspectRatio = msoFalse[/COLOR]
.Width = .Width * coef
.Height = .Height * coef
End With
Application.OnRepeat "", "" 'évite "Répéter Macros" menu Edition
End Sub

Nom = "X" & [COLOR="Red"]Replace([/COLOR]Application.Caller[COLOR="red"], " ", "_")[/COLOR] 'les noms doivent commencer par une lettre...