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

我希望这可以帮到你。

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

1 个答案: