使用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 @ 2019-12-01 21:32  PowerBI一图胜千言  阅读(1145)  评论(0编辑  收藏  举报