[發問] 多張圖片插入指定多欄位

cutekiss917

大家好 新年快樂
請教各位達人小弟因工作關係
每天都需回傳圖片並將圖片放入excel
由於1個檔案需要可能最多至150張之多
光是插入就要分好幾次插入(ㄧ次約10張)
然後再調整大小然後在把圖片拉到固定的欄位上
ㄧ天下來大概要處理800張以上眼睛真的是很受傷
是否有程式碼可以簡單化 謝謝!
1.直接插入並依照圖片編號插入指定序號欄位
2.調整圖片大小與欄位相符

圖片存放
D:\_Picture\20141231-LOWER-AC

圖片檔名(每次不同依相機拍攝後編號)
DSC04801~DSC04908

EXCEL版本 2003
電腦使用EXCEL版本2007

Return.rar (177.77 KB)

EXCEL圖片插入表
下載次數: 8

2014-12-31 18:27

luhpro

回復 1# cutekiss917
參考這串看是否能達到你的需求 :
[發問] 請問可否 插入圖檔時可以吻合儲存欄位大小

cutekiss917

回復  cutekiss917
參考這串看是否能達到你的需求 :
luhpro 發表於 2015-1-1 09:20

這篇我有看到 但我試不來
搞ㄧ整下午還是不行=.=

cutekiss917

這是我找到比較符合的程式碼
我改好久都改不出來我要的指定欄位與把檔名去掉
能請大大交我嗎
謝謝

1. Sub Ex()
   
2.     Dim AR(), i As Integer, ii As Integer, fs As String, Rng As Range
   
3.     With ActiveSheet
   
4.         .Cells = ""
   
5.         .Pictures.Delete
   
6.         fs = Dir("D:\_Picture\1\*.jpg")
   
7.         Do Until fs = ""
   
8.             ReDim Preserve AR(0 To i)
   
9.             AR(i) = fs  '圖片名稱置入陣列
   
10.             fs = Dir
    
11.             i = i + 1
    
12.         Loop
    
13.         For i = 0 To UBound(AR) Step 2
    
14.             For ii = 0 To 1
    
15.                 If ii + i <= UBound(AR) Then
    
16.                     .Cells(Int(i / 2) + 1, 1 + (ii * 2)) = AR(ii + i)
    
17.     Set Rng = .Cells(Int(i / 2) + 1, 2 + (ii * 2))
    
18.                     With .Pictures.Insert("D:\_Picture\1\" & AR(ii + i))
    
19.                         .Top = Rng.Top
    
20.                         .Left = Rng.Left
    
21.                         .Width = Rng.Width
    
22.                         .Height = Rng.Height
    
23.                 End With
    
24.                 End If
    
25.             Next
    
26.         Next
    
27.     End With
    
28. End Sub

複製代碼