收藏备用！！VBA操作图片【插入导出删除】

Sub 插入图片()
    Set Rng = Range("a1")
    i = ThisWorkbook.Path & "\" & "图片" & "\1.jpg"
    Sheet1.Shapes.AddPicture i, True, True, Rng.Left, Rng.Top, Rng.Width, Rng.Height
End Sub
'rng是你需要插入图片的单元格。前面需要给rng指定一下是哪个单元格
Sub 合并单元格插入图片()
    Range("d4").Select
    Set r = Selection
    i = ThisWorkbook.Path & "\" & "图片" & "\1.jpg"
    Sheet1.Shapes.AddPicture i, True, True, r.Left, r.Top, r.Width, r.Height
End Sub

Sub test()
    Dim rng As Range, com As Comment
    [a:a].ClearComments
    For Each rng In Range("a2", [a2].End(xlDown))
        Set com = rng.AddComment
        com.Shape.Fill.UserPicture ThisWorkbook.Path & "\素材图片\" & rng.Value
        com.Shape.Width = 100
        com.Shape.Height = 60
End Sub

Sub 保存文件中的图片()
    Dim ad$, m&, mc$, shp As Shape
    Dim nm$, n&, myFolder$
    Sheet1.Activate
    n = 0
    myFolder = ThisWorkbook.Path & "\图片\"     '指定文件夹名称
    For Each shp In ActiveSheet.Shapes
        If shp.Type = 13 Then
            If Len(Dir(myFolder, vbDirectory)) = 0 Then
                MkDir myFolder
            End If
            n = n + 1
            'ad = shp.TopLeftCell.Address
            m = shp.TopLeftCell.Row
            mc = Replace(Cells(m, 1).Address, "$", "")
            nm = Format(n, "00") & "-" & mc & ".jpg" '图形对象的名字
            shp.CopyPicture '将图形对象复制到剪切板
            With ActiveSheet.ChartObjects.Add(0, 0, shp.Width, shp.Height).Chart '在工作表中添加一个图表对象
                .Parent.Select
                .Paste '代码将剪切板中的图形对象以图片的格式粘贴到新添加的图表中
                .Export myFolder & nm, "JPG"
                .Parent.Delete '删除工作表中添加的图表对象
            End With
            'Range(ad) = nm
        End If
    MsgBox "完成"
End Sub

Sub 导出选定区域为图片()
    Call RangeToPic(Range("A1:D5")) '直接输入要输出的区域……必须有Range()
    Call RangeToPic(Selection) '按当前选中的区域
    Call RangeToPic(Application.InputBox("Select Range", Type:=8)) '出现对话框选择区域
End SubSub RangeToPic(Rng As Range, Optional Pnm = "", Optional Pth = "")
    If Pth = "" Then Pth = ActiveWorkbook.Path '默认使用当前文件所在路径作为输出路径
    If Pnm = "" Then Pnm = Left(ActiveWorkbook.Name, InStrRev(ActiveWorkbook.Name, ".") - 1) & "_" & Replace(Rng.Address(0, 0), ":", "_")
    '默认使用当前【文件名_区域地址】作为输出文件名
    If ActiveWindow.DisplayGridlines = True Then ActiveWindow.DisplayGridlines = False: flg = True '去掉默认格子线
    Rng.CopyPicture Appearance:=xlScreen, Format:=xlBitmap '把选择范围内容转化为截屏图片信息
    With ActiveSheet.ChartObjects.Add(0, 0, Rng.Width + 1, Rng.Height + 1).Chart '在A1处按图片尺寸稍大建立1个空白图表对象
        .ChartArea.Border.LineStyle = 0 '去除边框
        .Paste '把刚才截屏的图片信息粘贴上去
        .Export Pth & "\" & Pnm & ".jpg", "JPG"  '按指定图片路径及名称导出jgp格式图片……如果区域内有图片应该用这个
        .Export Pth & "\" & Pnm & ".png", "PNG"  '按指定图片路径及名称导出png格式图片……这个对于纯数据工作表来说更好
        .Parent.Delete '删去该临时增加的图表对象
    End With
    If flg Then ActiveWindow.DisplayGridlines = True '恢复默认格子线
End Sub

Sub 导出图表为图片()
    Dim myChart As Chart
    Dim myFileName As String
    Set myChart = Sheet1.ChartObjects(1).Chart
    myFileName = "myChart.jpg"
    myChart.Export Filename:=ThisWorkbook.Path & "/" & myFileName, Filtername:="JPG"
End Sub

Sub DeletePic()
    Dim p As Shape
    For Each p In ActiveSheet.Shapes
        If p.Type = 13 Then
            p.Delete
        End If
End Sub
'MsoShapeType 枚举
'指定形状的类型或形状范围?
'名称 值 描述
'msoAutoShape 1 自选图形。
'msoCallout 2 标注。
'msoCanvas 20 画布。
'msoChart 3 图。
'msoComment 4 批注。
'msoDiagram 21 图表。
'msoEmbeddedOLEObject 7 嵌入的 OLE 对象。
'msoFormControl 8 窗体控件。
'msoFreeform 5 任意多边形。
'msoGroup 6 组合。
'msoIgxGraphic 24 IGX 图形
'msoInk 22 墨迹
'msoInkComment 23 墨迹批注
'msoLine 9 线条
'msoLinkedOLEObject 10 链接 OLE 对象
'msoLinkedPicture 11 链接图片
'msoMedia 16 媒体
'msoOLEControlObject 12 OLE 控件对象
'msoPicture 13 图片
'msoPlaceholder 14 占位符
'msoScriptAnchor 18 脚本定位标记
'msoShapeTypeMixed -2 混和形状类型
'msoTable 19 表
'msoTextBox 17 文本框
'msoTextEffect 15 文本效果

Sub 求单元格中图片个数()
    For r = 2 To [a65536].End(xlUp).Row
        t = Range("b" & r).Top
        h = Range("b" & r).Height
        c = 0
        For Each s In ActiveSheet.Shapes
            If s.Top >= t And s.Top <= t + h Then