求助,怎么批量把一个文件下的多个EXCEL文件中的照片提取出来，以文件名命名

475012621

例子在附件里

475012621

有大佬吗？？？急切需要帮助

390717298

Sub ExtractPictures()
    Dim shp As Shape
    Dim i As Integer
    Dim sPath As String
    Dim sFileName As String
    Dim sExtension As String
    Dim sNewFileName As String
   
    sPath = ThisWorkbook.Path & "\"
    sFileName = Left(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, ".") - 1)
   
    For Each shp In ActiveSheet.Shapes
        If shp.Type = msoPicture Then
            i = i + 1
            sExtension = "." & Right(shp.Name, Len(shp.Name) - InStrRev(shp.Name, "."))
            sNewFileName = sPath & sFileName & "_" & i & sExtension
            shp.CopyPicture
            With New Chart
                .Paste
                .Export sNewFileName, "JPG"
                .Parent.Delete
            End With
        End If
    Next shp
End Sub

475012621

滴滴滴IDID滴滴滴滴滴

475012621

390717298 发表于 2023-3-22 16:43
Sub ExtractPictures()
    Dim shp As Shape
    Dim i As Integer

怎么使用啊大佬，小白不会

475012621

有人吗？有人吗？

475012621

急求啊急求

wanghan519

另存成html，删除不要的文件，图片改名
发现了一个问题，另存为html后，所有图片都多了一个缩略图，而另存为xlsx之后解压则不会有

1. $xl=New-Object -ComObject excel.application
   
2. Get-ChildItem *.xls* | % {$n=$_.BaseName;$wb=$xl.Workbooks.Open($_.FullName);$wb.SaveAs(($_.FullName+".html"), 44);$wb.Close();Remove-Item ($_.FullName+".html");Get-ChildItem ($_.FullName+".files") | % {if ($_.BaseName -match '^image') {$_ | Rename-Item -NewName {$_.Name -replace '^image', $n}} else {Remove-Item $_.FullName}}}
   
3. $xl.Quit()

复制代码

475012621

wanghan519 发表于 2023-3-24 06:06
另存成html，删除不要的文件，图片改名
发现了一个问题，另存为html后，所有图片都多了一个缩略图，而另存 ...

大佬，为啥我用的时候就报错呢？

475012621

wanghan519 发表于 2023-3-24 06:06
另存成html，删除不要的文件，图片改名
发现了一个问题，另存为html后，所有图片都多了一个缩略图，而另存 ...

C:\Users\Admin\Desktop\c6c7e33d29969f4090fc516d5ee7d0bc.png