Board logo

標題: [發問] 多張圖片插入指定多欄位 [打印本頁]
作者: cutekiss917    時間: 2014-12-31 18:31     標題: 多張圖片插入指定多欄位

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

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

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

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

[attach]19987[/attach]
作者: luhpro    時間: 2015-1-1 09:20

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

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


這篇我有看到 但我試不來
搞ㄧ整下午還是不行=.=
作者: cutekiss917    時間: 2015-1-6 21:13

這是我找到比較符合的程式碼
我改好久都改不出來我要的指定欄位與把檔名去掉
能請大大交我嗎
謝謝
  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
複製代碼




歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)