VBA调整粘贴图像到单元格的整个宽度/高度的大小

Question

我使用以下代码在粘贴到活动单元格时调整图像大小。

我希望图像缩放到单元格的 100% 宽度和高度。目前我似乎无法让它工作。该代码确实缩放了图像，但不是 100%。

请有人告诉我我哪里出错了？

 Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Application.DisplayAlerts = False

'Image Script
If Not Intersect(Target, Range("L:L")) Is Nothing Then ' <-- run this code only if a value in column L has changed
On Error GoTo 0
     'paste excel table as enhanced metafile, then resize to full width
    ActiveCell.Select
    ActiveSheet.Paste
    Selection.ShapeRange.ScaleWidth ActiveCell.Width, _
    msoFalse, msoScaleFromTopLeft
    Selection.ShapeRange.ScaleHeight ActiveCell.Height, _
    msoFalse, msoScaleFromTopLeft

    End If

End Sub

Answer 1

根据您的问题调整此代码

   ima = activecell.Top 'take the active cell top margin
   imb = activecell.Left 'take thee activecell left margin
   imc = activecell.Height 'take the activecell height
   imd = activecell.Width 'take the activecell width
   With Selection.ShapeRange
        .LockAspectRatio = msoFalse 'ignore aspect ratio of the image
        .Top = ima 'align image to the top margin of the activecell
        .Left = imb 'align image to the left margin of the activecell
        .Height = imc 'resize height to the activecell height
        .Width = imd 'resize width to the activecell width
   End With
   nam = Selection.ShapeRange.Name
   ActiveSheet.Shapes(nam).Placement = xlMoveAndSize 'resize image with the cell

我希望这可以帮助您。