vba 图片

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