应用场景

本地文件中的图片，引用到表中

知识要点

1：Shape 对象 代表绘图层中的对象，例如自选图形、任意多边形、OLE 对象或图片

2：Shape 对象是 Shapes 集合的成员。Shapes 集合包含某个工作簿中的所有形状

3：msoPicture 图片

4：TypeName 函数 返回一个 String，提供有关变量的信息

Sub 删除图片()

Dim sh As Shape '声明图形对象变量

For Each sh In ActiveSheet.Shapes '遍历本表所有图形对象

If sh.Type = msoPicture Then '如果是图片

sh.Delete '删除

End If

Next sh

End Sub

Sub 查找工作表中的图片并移动到要求位置()

Dim cell As Range, firstadd As String, activeshape As String

'如果选择对象不是图片则退出，否则复制当前对象

If TypeName(Selection) <> "Picture" Then Exit Sub Else Selection.Copy

activeshape = Selection.Name

'查找制表人位置

Set cell = Cells.Find("制表人：", lookat:=xlWhole)

If Not cell Is Nothing Then '如果已找到

firstadd = cell.Address '记录第一个找到的单元格地址

Do

ActiveSheet.Paste '黏贴图片

With Selection '设置图片的位置，让图片比单元格稍小一点

.Top = cell.Offset(0, 1).Top + 1

.Left = cell.Offset(0, 1).Left + 1

.Width = cell.Offset(0, 1).Width - 1

.Height = cell.Offset(0, 1).Height - 1

End With

Set cell = FindNext(cell) '查找下一个

Loop While cell.Address = firstadd '直到找到的地址等于首个单元格地址

End If

ActiveSheet.Shapes(activeshape).Delete '删除原有图片

End Sub