求：图片自适应单元格大小代码？

独领

如题，见附件。

谢谢各位大佬老师的帮助！！！

求：图片适应单元格代码？.zip (1.84 MB, 下载次数: 0)

昨天 19:50 上传

点击文件名下载附件

问题得到完美解决，感谢三楼的ynzsvt老师，他不厌其烦的反复解答修正，代码得到完美效果！
感谢各位老师！！！

科学胜

这里有个问题，拉大或者缩小导致图片位置对不上了怎么办

虾爬子我们走

• Sub 图片大小()
  
• Dim Shp As Shape, Rng As Range
  
• For Each Shp In ActiveSheet.Shapes
  
•   Shp.Left = Shp.Left + 1
  
•   Shp.Top = Shp.Top + 1
  
•   Set Rng = Shp.TopLeftCell
  
•   Shp.Left = Rng.Left
  
•   Shp.Top = Rng.Top
  
•   Shp.Width = Rng.Width
  
•   Shp.Height = Rng.Height
  
• NextEnd Sub
  

吕亿亿

易赫斋风水社

图片自适应单元格大小

求：图片适应单元格代码？.zip (1.85 MB, 下载次数: 0)

昨天 19:50 上传

点击文件名下载附件

达姆

• Sub 图片调整()
  
•     Dim ws As Worksheet
  
•     Dim i As Long, j As Long
  
•     Set ws = ActiveSheet
  
•     Application.ScreenUpdating = False
  
•     For Each Shp In ws.Shapes
  
•         With Shp
  
•             If .Type = msoPicture Then
  
•                 i = .TopLeftCell.Row
  
•                 j = .TopLeftCell.Column
  
•                 .ZOrder msoBringToFront
  
•                 .Left = ws.Cells(i, j).Left + 1
  
•                 .Top = ws.Cells(i, j).Top + 1
  
•                 .Width = ws.Cells(i, j).Width - 2
  
•                 .Height = ws.Cells(i, j).Height - 2
  
•              End If
  
•         End With
  
•     Next Shp
  
•     Application.ScreenUpdating = True
  
•     MsgBox "图片大小调整完成！"
  
• End Sub
  

信杰廉悍

<ol>Sub ykcbf()    '//2026.04.25 将单元格内已有图片充满单元格
    Const Gap As Long = 1
    Application.ScreenUpdating = False
    Set ws = ActiveSheet
    r = ws.Cells.Find(&quot;*&quot;, , xlValues, , xlByRows, xlPrevious).Row
    For Each shp In ws.Shapes
        If shp.Type = msoPicture Then
            Set rng = shp.TopLeftCell
            If rng.Column = 4 And rng.Row >= 3 And rng.Row

孙晓靖

求：图片适应单元格代码？.rar (147.02 KB, 下载次数: 0)

昨天 19:50 上传

点击文件名下载附件

夏日清荷

老师：这个代码实现了90%的要求，就是有一点，按钮点完适应单元格大小后，拉动列宽，图片会随单元格变动，但拉动行宽时，图片不会随单元格变动。
劳烦老师再修正以下代码。
谢谢！

吕亿亿

老师：按钮了，图片不动。
您再看看。谢谢！