求助 怎么把一堆图片，批量导入EXCEL中，在线等急啊

康剑丽

是这样的，我有一堆图片要导到excel中，每行一个，最好图片大小能随EXCEl的大小变化，求帮忙啊

grf1973

以前编过的，自己改改吧

1. Sub main()
   
2.     Dim Fn$, Fil
   
3.     Dim F1 As String
   
4.     Dim Filename As String
   
5.    
   
6.     Set d = CreateObject("Scripting.Dictionary")
   
7.     Fn = Dir(ThisWorkbook.Path & "\照片\*.JPG"): d(Fn) = ""
   
8.     Do While Fn <> ""
   
9.         Fn = Dir: d(Fn) = ""
   
10.     Loop            '读取所有“照片”文件中jpg文件，存入字典
    
11.    
    
12.    
    
13.         F1 = Sheets("其它").[e3].Text & ".JPG"    '文件名
    
14.         
    
15.         If d.exists(F1) = True Then     '如果文件存在，在指定位置插入文件
    
16.             Filename = ThisWorkbook.Path & "\照片" & F1
    
17.             Sheets("其它").[j4].Select
    
18.             h = Selection.Height: w = Selection.Width
    
19.             Selection.ClearContents
    
20.             ActiveSheet.Pictures.Insert(Filename).Select
    
21.             Selection.ShapeRange.LockAspectRatio = msoFalse
    
22.             Selection.ShapeRange.Height = h
    
23.             Selection.ShapeRange.Width = w
    
24. 
    
25.         Else
    
26.             MsgBox F1 & "缺失照片信息"
    
27.         End If
    
28. End Sub

复制代码