批量提取excel中照片怎么弄

哈喽哈哈1

1. Sub ExportImagesFromShapesAsJPG()
   
2.     Dim ws As Worksheet
   
3.     Dim img As Shape
   
4.     Dim myPath As String
   
5.     Dim savePath As String
   
6.     Dim savename As String
   
7.     Dim excelFile As String
   
8.     Dim wb As Workbook
   
9.     Dim chrt As Chart
   
10.     Dim fso As Object
    
11.    
    
12.     Application.ScreenUpdating = False
    
13.     Application.EnableEvents = False
    
14.    
    
15.     ' 设定文件夹路径
    
16.     myPath = ThisWorkbook.Path & "\工艺文件"
    
17.     savePath = myPath & "\提取的图片"
    
18.    
    
19.     ' 创建文件系统对象
    
20.     Set fso = CreateObject("Scripting.FileSystemObject")
    
21.    
    
22.     ' 如果文件夹不存在，则创建它
    
23.     If Not fso.FolderExists(savePath) Then fso.CreateFolder (savePath)
    
24.    
    
25.     ' 获取文件夹内的第一个Excel文件
    
26.     excelFile = Dir(myPath & "\*.xlsx")
    
27.    
    
28.     ' 遍历并处理文件夹内的所有Excel文件
    
29.     Do While excelFile <> ""
    
30.         ' 打开特定名称的Excel文件
    
31.         Set wb = Workbooks.Open(myPath & "" & excelFile)
    
32.         
    
33.         ' 遍历所有工作表
    
34.         For Each ws In wb.Worksheets
    
35.             ' 检查AA3单元格是否有值
    
36.             If ws.Range("AA3").Value <> "" Then
    
37.                 savename = ws.Range("AA3").Value & ".jpg"
    
38.                
    
39.                 ' 遍历工作表中的所有形状
    
40.                 For Each img In ws.Shapes
    
41.                     ' 检查形状是否为图片类型
    
42.                     If img.Type = 13 Then ' 在 Excel 中，13 通常代表图片
    
43.                         ' 复制图片
    
44.                         img.Copy
    
45.                         
    
46.                         ' 添加一个新图表作为粘贴目标
    
47.                         Set chrt = wb.Charts.Add
    
48.                         
    
49.                         ' 将图片粘贴到图表中
    
50.                         With chrt
    
51.                             .Paste
    
52.                             ' 导出图表为图片文件
    
53.                             .Export fileName:=savePath & savename, Filtername:="JPG"
    
54.                             ' 删除图表
    
55.                             .Delete
    
56.                         End With
    
57.                         
    
58.                         ' 清除剪贴板
    
59.                         Application.CutCopyMode = False
    
60.                     End If
    
61.                 Next img
    
62.             End If
    
63.         Next ws
    
64.         
    
65.         ' 关闭工作簿
    
66.         wb.Close SaveChanges:=False
    
67.         
    
68.         ' 获取下一个Excel文件
    
69.         excelFile = Dir()
    
70.     Loop
    
71.    
    
72.     ' 清理文件系统对象
    
73.     Set fso = Nothing
    
74.    
    
75.     Application.ScreenUpdating = True
    
76.     Application.EnableEvents = True
    
77.    
    
78.     MsgBox "所有图片已提取完毕，并保存为JPG格式！"
    
79. End Sub
    

复制代码

  各位老师帮忙看一下，为什么提取出来的照片都是空白内容。有没有什么办法可以进行改进？

dodo2029

先选中   .select

Yalishanda30

7ZIP解压缩法

usedrange

这个还是用python的openpyxl模块方便

哈喽哈哈1

Yalishanda30 发表于 2024-9-30 15:04
7ZIP解压缩法

不是很理解。

哈喽哈哈1

usedrange 发表于 2024-9-30 15:09
这个还是用python的openpyxl模块方便

不会用python，是个新手。

哈喽哈哈1

dodo2029 发表于 2024-9-30 15:03
先选中   .select

可否具体一下？

songshihai

这样!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

z865593849

用 插。件 或者 WPS .....

哈喽哈哈1

songshihai 发表于 2024-10-5 08:56
这样!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

好的，老师。我把这个带进去看一下