使用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

 

　　　　

　　　　

申明：本文版权归作者和博客园共有，欢迎转载，但未经作者同意必须保留此段声明，且在文章页面明显位置给出原文连接，否则保留追究法律责任的权利。
posted @ 2021-11-07 12:03  阿星随记  阅读(832)  评论(0)  编辑  收藏  举报