VBA,碰到读图片和写图片:
从工作表中导出图片
Sub Macro01() '从工作表中保存图片
Application.ScreenUpdating = False
Dim pth, shp, n
pth = ThisWorkbook.Path & "导出图片"
For Each shp In ActiveSheet.Shapes
If shp.Type = 13 Then
n = n + 1
shp.Copy
With ActiveSheet.ChartObjects.Add(0, 0, shp.Width, shp.Height).Chart
.Parent.Select
.Paste
.Export pth & shp.TopLeftCell.Offset(0, -1) & ".jpg"
.Parent.Delete
End With
End If
Next
Application.ScreenUpdating = True
End Sub
从文件夹读取图片
Sub Macro02() '从文件夹中读写图片
Dim fso, shp, j, rng, str1, w, y
Set fso = CreateObject("Scripting.FileSystemObject")
Application.ScreenUpdating = False
For Each shp In ActiveSheet.Shapes
If shp.Type = 11 Then shp.Delete
Next shp
For j = 5 To 70
Cells(j, 6).Select
Set rng = Selection
str1 = ThisWorkbook.Path & "导出图片" & Cells(j, 6) & ".jpg"
If fso.FileExists(str1) Then
ActiveSheet.Pictures.Insert(str1).Select
With Selection
.Top = rng.Offset(0, 1).Top
.Left = rng.Offset(0, 1).Left
.Height = rng.Offset(0, 1).Height
.Width = rng.Offset(0, 1).Left - rng.Left - 2
End With
End If
Next j
Application.ScreenUpdating = True
End Sub
删除工作表的图片
Sub Macro04() '删除工作表中的图片
Application.ScreenUpdating = False
Dim oSP As Shape
For Each oSP In ActiveSheet.Shapes
If oSP.Type = 11 Then
oSP.Delete
End If
Next
Application.ScreenUpdating = True
End Sub
作者:薛定谔的ハチ公
申明:本文版权归作者和博客园共有,欢迎转载,但未经作者同意必须保留此段声明,且在文章页面明显位置给出原文连接,否则保留追究法律责任的权利。