|
Sub VBA导出指定单元格为JPG图片()
Dim p$
p = ThisWorkbook.Path & "\图片\" '文件夹,路径及名字
If Dir(p, vbDirectory) = "" Then MkDir (p) '没有该文件夹就创建,有就不管
Dim i%, r&
r = Cells(Rows.Count, 2).End(xlUp).Row
For i = 2 To r - 3 Step 5
Cells(i, 2).CurrentRegion.Copy '复制区域
ActiveSheet.Pictures.Paste.Select '粘贴成图片
Selection.ShapeRange.Name = Cells(i, "j") '命名
Selection.Copy
With ActiveSheet.ChartObjects.Add(0, 0, Selection.Width, Selection.Height).Chart '导出图片
.Parent.Select
.Paste
.Export p & Cells(i, "j") & ".jpg", "jpg" '导出图片。
.Parent.Delete
End With
Dim shp As Shape ' 删除生成的表格图片
For Each shp In ActiveSheet.Shapes
If shp.Name = Cells(i, "j") Then shp.Delete
Next
Next
MsgBox "OK"
End Sub
仅供参考。。。 |
|