多个文件夹内查找图片

小小晶enjoy

我想请教一下，我在一张表格中需要插入对应的图片，但是这些图片是在一个文件夹下面的各文件夹中，可能是一级文件夹，也可能是二级文件夹等，我如何用VBA插入对应的图片呢，谢谢~~




插入图片.zip (214.31 KB, 下载次数: 7)

2025-3-28 14:54 上传

点击文件名下载附件

鄂龙蒙

本文件夹及子文件夹循环查找后插入

小小晶enjoy

鄂龙蒙 发表于 2025-3-28 17:03
本文件夹及子文件夹循环查找后插入

请问是利用递归吗？我找了很多资料也没搞清楚这个递归

Again123456

1. //搞个jpg的试试吧
   
2. function test(){
   
3.         let fs = FileSystem
   
4.         let dfs = (path, rg) =>{               
   
5.                 let subItems = fs.readdirSync(path)
   
6.                 let picName = rg.Offset(0,-1).Text + '.jpg'
   
7.                 subItems.forEach(subItem => {
   
8.                         let curItem = `${path}/${subItem}`
   
9.                         if(fs.stat(curItem).isFile() && subItem == picName)        rg.RangeEx.InsertCellPicture(curItem)
   
10.                         if(fs.stat(curItem).isDirectory())        dfs(curItem,rg)                       
    
11.                 })               
    
12.         }
    
13.         let path = ThisWorkbook.Path
    
14.         for (let rg of Range("b2:b5"))         dfs(path,rg)
    
15. }

复制代码

Again123456

小小晶enjoy 发表于 2025-3-28 19:12
请问是利用递归吗？我找了很多资料也没搞清楚这个递归

Again123456

工作簿1.rar (208.61 KB, 下载次数: 1)

2025-3-28 23:02 上传

点击文件名下载附件

wanghan519

因为用到了imagemagick把webp转换为png再插入
所以索性写个批处理

1. #ANSI编码&cls&powershell -Version 5.1 -NoLogo -NoProfile -Command "gc -Encoding Oem -ReadCount 0 -LiteralPath '%~f0'|out-string|iex"&pause&exit/b
   
2. $xl = New-Object -ComObject Excel.Application
   
3. $wb = $xl.Workbooks.Open((Resolve-Path '.\新建 Microsoft Excel 工作表.xlsx').Path)
   
4. $r = 2
   
5. while ($true) {
   
6.     $t = $wb.Sheets(1).Range('A' + $r).Value2
   
7.     if ($t -ne $null) {$r++} else {break}
   
8.     $f = gci -Recurse | ?{$_.Name -match $t} | select -First 1
   
9.     magick $f.Fullname 'tmp.png'
   
10.     $p = $wb.Sheets(1).Shapes.AddPicture((Resolve-Path 'tmp.png').Path, 0, -1,
    
11.     $wb.Sheets(1).Range('B' + ($r - 1)).Left,
    
12.     $wb.Sheets(1).Range('B' + ($r - 1)).Top,
    
13.     100, 120)
    
14.     rm tmp.png
    
15.     $wb.Sheets(1).Range('B' + ($r - 1)).EntireRow.RowHeight = $p.Height
    
16. }
    
17. $wb.Save()
    
18. $wb.Close()
    
19. $xl.Quit()

复制代码

wanghan519

忘了说，上面的代码需要安装imagemagick才能用，用来转换webp图片为png
代码的意思问一下ai就行，解释的非常详细，比我说得好

Again123456

wanghan519 发表于 2025-3-29 04:54
因为用到了imagemagick把webp转换为png再插入
所以索性写个批处理

可以直接嵌入