下载所有图片到本地文件夹【未测试】

经验创意 · 35 次浏览
Ulookperfect... 创建于 15天12小时前

 

 

代码:Sub ExportImagesFromCurrentWorkbook()
    Dim i As Integer ' 用于遍历工作簿中的工作表索引
    Dim k As Integer ' 用于为导出的图片文件命名
    Dim sheet As Worksheet ' 用于引用当前处理的工作表
    Dim shape As shape ' 用于引用当前处理的图形对象
    Dim chartObj As ChartObject ' 用于创建并引用图表对象

    ' 关闭屏幕更新,以提高代码执行效率
    Application.ScreenUpdating = False
    
    ' 初始化图片命名计数器
    k = 0

    ' 开始处理当前工作簿
    With ThisWorkbook
        ' 遍历工作簿中的所有工作表
        For i = 1 To .Sheets.Count
            Set sheet = .Sheets(i)
            ' 遍历当前工作表中的所有图形对象
            For Each shape In sheet.Shapes
                ' 为导出的图片增加计数
                k = k + 1
                ' 复制图形对象到剪贴板
                shape.Copy
                ' 在工作表上创建一个新的图表对象,大小与图形对象相同
                Set chartObj = sheet.ChartObjects.Add(0, 0, shape.Width, shape.Height)
                ' 将剪贴板的内容粘贴到图表对象中
                With chartObj.Chart
                    .Paste
                    ' 导出图表对象为 PNG 图片,文件名包含工作簿名和图片序号
                    .Export ThisWorkbook.Path & "\" & .Parent.Name & "_" & k & ".png"
                End With
                ' 删除图表对象,释放资源
                chartObj.Delete
            Next shape
        Next i
    End With

    ' 恢复屏幕更新
    Application.ScreenUpdating = True
End Sub


回复内容
暂无回复
回复主贴