如何判断单元格内是否有图片，并在单元格内显示

Strive_TL

请大神调整下代码，如何判断某单元格内（或者整列）是否有图片，若无图片的话在单元格内显示"无此图片"，有图片的话正常显示图片。如图

liulang0808

楼主附件代码有添加图片的，可以先删除所有图片，然后追加
如果判断单元格内是否有图片，可以先遍历所有图片的左上角坐标，然后根据单元格的左上角位置进行匹配，。前提是图片都是按照这个需求添加进去的

Strive_TL

liulang0808 发表于 2021-3-2 11:43
楼主附件代码有添加图片的，可以先删除所有图片，然后追加
如果判断单元格内是否有图片，可以先遍历所有图 ...

没太理解，还请版主大人帮想看下

ggmmlol

Sub test()
    Dim r&, shp As Shape
    r = Cells(Rows.Count, 1).End(xlUp).Row - 1
    If r = 0 Then Exit Sub
    Range("B2").Resize(r) = "无此图片"
    For Each shp In Me.Shapes
        shp.TopLeftCell = ""
    Next
End Sub

liulang0808

Sub 插入图片()
    On Error Resume Next
    Dim t As String, fd
    Dim MR As Range
    Set fd = Application.FileDialog(msoFileDialogFolderPicker)    '允许用户选择一个文件夹
    If fd.Show = -1 Then
        t = fd.SelectedItems(1)    '选择之后就记录这个文件夹名称
    Else
        Exit Sub    '否则就退出程序
    End If
    Set fso = CreateObject("scripting.filesystemobject")
    For Each MR In Range("a2:a" & Cells(Rows.Count, 1).End(3).Row)
    If Not IsEmpty(MR) Then
        pic = t & "\" & MR.Value & ".jpg"
        If fso.fileexists(pic) Then
            MR.Select
            ML = MR.Left + MR.Width
            MT = MR.Top
            MW = MR.Width
            MH = MR.Height
            ActiveSheet.Shapes.AddShape(msoShapeRectangle, ML, MT, MW, MH).Select
            Selection.ShapeRange.Fill.UserPicture pic     '当前文件所在目录下以当前单元内容为名称的.jpg图片
        Else
            MR.Offset(0, 1).Value = "无此图片"
        End If
    End If
    Next
End Sub