哪位大神可以帮忙给这段批量插图代码增加个图片检测功能

tjlpc

哪位老师可以帮忙给下面这个批量插图代码，增加个功能，可以实现，在插入的时候，检测要插入图片的这个单元格上已经有图片了，就自动跳过这个单元格的图片插入，而不是在这个位置上覆盖一张图片。、

--------以下是图片插入代码---------------------------



Sub AAA()
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
p = InputBox("请选择图片插入位置，上，下，左，右依次用1，2，3，4代替", "请选择位置")
Set fso = CreateObject("scripting.filesystemobject")
For Each MR In Selection
If Not IsEmpty(MR) Then
pic = T & "\" & MR.Value & ".jpg"
If fso.FileExists(pic) Then
MR.Select
If (p = 1) Then '上
ML = MR.Left
MT = MR.Top - MR.Height
MW = MR.Width
MH = MR.Height
ElseIf (p = 2) Then '下
ML = MR.Left
MT = MR.Top + MR.Height
MW = MR.Width
MH = MR.Height
ElseIf (p = 3) Then '左
ML = MR.Left - MR.Width
MT = MR.Top
MW = MR.Width
MH = MR.Height
ElseIf (p = 4) Then '右
ML = MR.Left + MR.Width
MT = MR.Top
MW = MR.Width
MH = MR.Height
End If
ActiveSheet.Shapes.AddShape(msoShapeRectangle, ML, MT, MW, MH).Select
Selection.ShapeRange.Fill.UserPicture pic '当前文件所在目录下以当前单元内容为名称的.jpg图片
End If
End If
Next
End Sub

tjlpc

原来没人知道

hongshan2019

我觉得会有人解决，但也可以变通一下，把所有图片删除再运行这段代码

liulang0808

具体根据楼主表格内图片覆盖情况取判断
先遍历每张图片，比如判断图片的TopLeftCell这个属性是否可以
或者left+top属性组合判断。

perfect131

先遍历 单元格地址赋值字典
参考：8 楼
https://club.excelhome.net/forum ... 74&pid=11149560