Créer macro pour redimensionner images ?

Sub images()
Dim image As InlineShape
Dim image2 As Shape
For Each image In ActiveDocument.InlineShapes
image.ConvertToShape
Next
For Each image2 In ActiveDocument.Shapes
image2.Height = CentimetersToPoints(6)
image2.WrapFormat.Type = wdWrapBehind
Next
End Sub

Sub image()

On Error Resume Next
Selection.InlineShapes(1).ConvertToShape
On Error GoTo erreur
With Selection.ShapeRange
.Height = CentimetersToPoints(6)
.WrapFormat.Type = wdWrapBehind
End With

Exit Sub
erreur:  MsgBox "la sélection ne contient pas d'image"

End Sub