[已解决]批量插入图片

蒋正栋jzd

     如何按照编号对应的图片命名批量插入图片
  1：图片对应A 的编号放到B列的单元格
  2：如果找到图片在对应的C列写入“Yes”，如果没有找到图片写入“No”

最佳答案

月排行榜 / 总排行榜

王英wang

2017-5-15 11:35

Sub plcrtp()
Dim path$, i&, rng As Range, shp As Shape
Application.ScreenUpdating = False
On Error Resume Next
path = ThisWorkbook.path & "\"
Set sh = ActiveSheet
    For Each p In ActiveSheet.Pictures
        p.Delete
    Next
lr = Cells(Rows.Count, 1).End(3).Row
For i = 2 To Cells(Rows.Count, 1).End(3).Row
    Set rng = Cells(i, 1).Offset(0, 1)
    ActiveSheet.Pictures.Insert(path & Cells(i, 1) & ".jpg").Select
    With Selection
        .ShapeRange.LockAspectRatio = msoFalse
        .Left = rng.Left + 2
        .Top = rng.Top + 2
        .Height = rng.Height - 4
        .Width = rng.Width - 4
    End With
[a1].Select
Next
sh.Select
Application.ScreenUpdating = True
    For i1 = 1 To ActiveSheet.Shapes.Count
        Set sh = ActiveSheet.Shapes(i1)
        sh.TopLeftCell.Offset(0, 1).Value = "Yes"
    Next
End Sub

跳转到最佳答案楼层

王英wang

Sub plcrtp()
Dim path$, i&, rng As Range, shp As Shape
Application.ScreenUpdating = False
On Error Resume Next
path = ThisWorkbook.path & "\"
Set sh = ActiveSheet
    For Each p In ActiveSheet.Pictures
        p.Delete
    Next
lr = Cells(Rows.Count, 1).End(3).Row
For i = 2 To Cells(Rows.Count, 1).End(3).Row
    Set rng = Cells(i, 1).Offset(0, 1)
    ActiveSheet.Pictures.Insert(path & Cells(i, 1) & ".jpg").Select
    With Selection
        .ShapeRange.LockAspectRatio = msoFalse
        .Left = rng.Left + 2
        .Top = rng.Top + 2
        .Height = rng.Height - 4
        .Width = rng.Width - 4
    End With
[a1].Select
Next
sh.Select
Application.ScreenUpdating = True
    For i1 = 1 To ActiveSheet.Shapes.Count
        Set sh = ActiveSheet.Shapes(i1)
        sh.TopLeftCell.Offset(0, 1).Value = "Yes"
    Next
End Sub

王英wang

如附件

蒋正栋jzd

谢谢美女，非常感谢