Change height of an image while maintaining the width ratio in VBA - vba

Question

After cropping the image, I wish to use macro to change the height of all image while maintaining the width to height ratio so that the image does not look weird . Currently, my code change the correct height but it does not maintain the width to height ratio
Sub resizeall()
Dim i As Long
With ActiveDocument
For i = 1 To .InlineShapes.Count
With .InlineShapes(i)
.LockAspectRatio = msoTrue
.Height = CentimetersToPoints(6.9)
End With
Next i
End With
End Sub
Any advice will be appreciated
I have try
.LockAspectRatio = msoTrue
.Top = Range("B7").Top
.Left = Range("B7").Left
.ShapeRange.LockAspectRatio = msoTrue
.Height = CentimetersToPoints(6.9)
I am a complete beginner , I been googling but it does not seem to work for me. I could resize the image in word by moving the corner of the image while pressing shift but there too many images.
I found this forum https://www.mrexcel.com/board/threads/insert-and-resize-picture-maintaining-aspect-ratio.1010711/ but I don't understand it and can't incorporate it with my current code.

Answer 1

To resize all images to a common height you can use the following:
Sub resizeall()
Dim i As Long
Dim newHeight As Single: newHeight = CentimetersToPoints(6.9)
With ActiveDocument
For i = 1 To .InlineShapes.Count
With .InlineShapes(i)
.LockAspectRatio = msoTrue
.Width = AspectWidth(.Width, .Height, newHeight)
.Height = newHeight
End With
Next i
End With
End Sub
Public Function AspectWidth(ByVal OrigWidth As Single, ByVal OrigHeight As Single, _
ByVal newHeight As Single) As Single
'Calculates the new width in relation to the supplied new height
'maintaining the aspect ratio of the original width/height
If OrigHeight <> 0 Then
AspectWidth = (OrigWidth / OrigHeight) * newHeight
Else
AspectWidth = 0
End If
End Function