Function zoom(ByVal shape As ShapeRange, ByVal img As image, ByVal rng As Range)
Dim orgWidth As Double
Dim orgHeight As Double
Dim retHeight As Double
Dim retWidth As Double
Dim toWidth, toHeight As Double
orgWidth = img.Picture.Width
orgHeight = img.Picture.Height
toWidth = rng.MergeArea.Width - 4
toHeight = rng.MergeArea.Height - 4
If toWidth > toHeight Then
If orgHeight > orgWidth Then
retHeight = toHeight
retWidth = orgWidth / orgHeight * toHeight
End If
If orgHeight < orgWidth Then
If orgHeight / orgWidth * toWidth > toHeight Then
retHeight = toHeight
retWidth = orgWidth / orgHeight * toHeight
Else
retWidth = toWidth
retHeight = orgHeight / orgWidth * toWidth
End If
End If
If orgHeight = orgWidth Then
retHeight = toHeight
retWidth = orgWidth / orgHeight * toHeight
End If
End If
If toWidth < toHeight Then
If orgHeight > orgWidth Then
If orgWidth / orgHeight * toHeight > toWidth Then
retWidth = toWidth
retHeight = orgHeight / orgWidth * toWidth
Else
retHeight = toHeight
retWidth = orgWidth / orgHeight * toHeight
End If
End If
If orgHeight < orgWidth Then
retWidth = toWidth
retHeight = orgHeight / orgWidth * toWidth
End If
If orgHeight = orgWidth Then
retWidth = toWidth
retHeight = orgHeight / orgWidth * toWidth
End If
End If
If toWidth = toHeight Then
If orgHeight > orgWidth Then
retHeight = toHeight
retWidth = orgWidth / orgHeight * toHeight
End If
If orgHeight < orgWidth Then
retWidth = toWidth
retHeight = orgHeight / orgWidth * toWidth
End If
If orgHeight = orgWidth Then
retHeight = toHeight
retWidth = toWidth
End If
End If
shape.LockAspectRatio = msoFalse
shape.Width = retWidth
shape.Height = retHeight
shape.Rotation = 0#
shape.Top = rng.MergeArea.Top + rng.MergeArea.Height / 2 - retHeight / 2
shape.Left = rng.MergeArea.Left + rng.MergeArea.Width / 2 - retWidth / 2
End Function