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").SelectSet r = Selectioni = 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].ClearCommentsFor Each rng In Range("a2", [a2].End(xlDown))Set com = rng.AddCommentcom.Shape.Fill.UserPicture ThisWorkbook.Path & "素材图片" & rng.Valuecom.Shape.Width = 100com.Shape.Height = 60Next
End Sub

Sub 保存文件中的图片()Dim ad$, m&, mc$, shp As ShapeDim nm$, n&, myFolder$Sheet1.Activaten = 0myFolder = ThisWorkbook.Path & "图片"     '指定文件夹名称For Each shp In ActiveSheet.ShapesIf shp.Type = 13 ThenIf Len(Dir(myFolder, vbDirectory)) = 0 ThenMkDir myFolderEnd Ifn = n + 1'ad = shp.TopLeftCell.Addressm = shp.TopLeftCell.Rowmc = 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) = nmEnd IfNextMsgBox "完成"
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 WithIf flg Then ActiveWindow.DisplayGridlines = True '恢复默认格子线
End Sub

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

Sub DeletePic()Dim p As ShapeFor Each p In ActiveSheet.ShapesIf p.Type = 13 Thenp.DeleteEnd IfNext
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).Rowt = Range("b" & r).Toph = Range("b" & r).Heightc = 0For Each s In ActiveSheet.ShapesIf s.Top >= t And s.Top <= t + h Thenc = c + 1End IfNextRange("c" & r) = cNext r
End Sub