使用VBA从工作表中读图片,以及给工作表中写文件
因为工作的原因,需要用到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
作者:薛定谔的ハチ公
申明:本文版权归作者和博客园共有,欢迎转载,但未经作者同意必须保留此段声明,且在文章页面明显位置给出原文连接,否则保留追究法律责任的权利。