muusie 发表于 2017-8-7 20:24:14

图片按照特定要求插入求助

各位老师，你们好，我虽然下载了论坛上的VBA 但是自己研究后还是有点不理解，能否再次帮助我小白一下，不胜感激。

wengjl 发表于 2017-8-7 21:32:02

求助。。。。

tina1979 发表于 2017-8-7 21:59:28

Sub 填充照片()
Application.ScreenUpdating = False
Dim x, k As Integer
Dim fs1$
For Each a In Sheet1.Pictures
    a.Delete
Next
k = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
For x = 2 To k
fs1 = ThisWorkbook.Path & "图片" & CStr(Sheet1.Cells(x, 1)) & ".jpg"
    If Dir(fs1) <> &quot;&quot; Then
    Sheet1.Select
      Sheet1.Range(&quot;c&quot; & x).Select
       ActiveSheet.Pictures.Insert(fs1).Select
       With Selection.ShapeRange
         Selection.ShapeRange.LockAspectRatio = msoFalse
            .Top = Sheet1.Range(&quot;c&quot; & x).Top + 1
            .Left = Sheet1.Range(&quot;c&quot; & x).Left + 1
            .Width = Sheet1.Range(&quot;c&quot; & x).Width - 1
            .Height = Sheet1.Range(&quot;c&quot; & x).Height - 1
      End With
    End If
Next x
Application.ScreenUpdating = True
End Sub

岁月如歌 发表于 2017-8-7 23:31:57


sambohuang 发表于 2017-8-8 00:03:36

谢谢朱老师，感激涕零
页: [1]
查看完整版本: 图片按照特定要求插入求助