插入图片后的尺寸和位置，怎么调整？

深秋的黎明

3190496160 发表于 2020-9-20 12:50

谢啦，图片按照单元格自动伸缩

3190496160

aecn 发表于 2020-9-20 14:35
Sub insertPic()
    Dim i As Integer
    Dim FilPath As String

Sub insertPic()
    Dim i As Integer
    Dim FilPath As String
    Dim rng As Range
    Dim s As String
        For Each myShape In Sheet1.Pictures
        myShape.Delete
    Next
    For j = 1 To 4 Step 3
            For i = 3 To Sheet1.Range("a65536").End(3).Row
                FilPath = ThisWorkbook.Path & "\" & Sheet1.Cells(i, j).Text & ".jpg"
                If Dir(FilPath) <> "" Then
                    Sheet1.Pictures.Insert(FilPath).Select
                    Selection.ShapeRange.LockAspectRatio = msoFalse
                    With Selection
                        .Width = Sheet1.Range(Sheet1.Cells(i, j + 1).Address).Width
                        .Height = Sheet1.Range(Sheet1.Cells(i, j + 1).Address).Height
                         .Top = Sheet1.Range(Sheet1.Cells(i, j + 1).Address).Top
                         .Left = Sheet1.Range(Sheet1.Cells(i, j + 1).Address).Left
                     End With
                End If
            Next i
    Next j
End Sub

3190496160

测试.rar (729.94 KB, 下载次数: 48)

2020-9-20 20:36 上传

点击文件名下载附件

深秋的黎明

3190496160 发表于 2020-9-20 20:36

果断解决问题

aecn

3190496160 发表于 2020-9-20 20:35
Sub insertPic()
    Dim i As Integer
    Dim FilPath As String

用 Step ，学习了