[發問] 如何篩選圖片,並插入指定的欄位

jackyliu

請教 高手們:
要如何將C:\TEST\地下的圖片 經過篩選 插入所定義的欄位內,
可否幫忙一下,因權限關係,可否貼程式碼.... 如附件 ! 萬分感激 !

已知條件
1. 圖片插入範圍H、I、J、K、L、M
2. 圖片儲存位置於C:\TEST\*.JPG(副檔名)
3. 圖片命名規則1-T、1-T-O
4. 圖片插入規則1為插入第一列、T為插入第一列的(T)第三碼為0、1、2、3, 若有第三碼則依序插入至K、L、M 欄位
5. 圖片大小 高度2.7cm、寬度3.6cm
6. 資料比數不設限10筆,所以 匯差入的圖片可能會到達第200列的某欄位

Hsieh

回復 1# jackyliu

圖片命名規則不是很懂，先試試這樣看怎樣不同

1. Sub Ex()
   
2. Dim A As Range, C As Range
   
3. ar = Array("C", "F", "T")
   
4. ay = Array(8, 9, 10)
   
5. ak = Array("", 0, 1, 2, 3)
   
6. fd = "C:\TEST\" '圖片目錄
   
7. With Sheet1
   
8. .Pictures.Delete
   
9. For Each C In .Range(.[C3], .[C65536].End(xlUp))
   
10. r = C.Row
    
11.     For i = 0 To 2
    
12.        For j = 0 To 3
    
13.        mystr = IIf(ak(j) = "", "", "-" & ak(j))
    
14.        fs = C & "-" & ar(i) & mystr & ".jpg"
    
15.        If Dir(fd & fs) <> "" Then
    
16.           Set A = .Cells(r, IIf(j = 0, ay(i), 10 + j))
    
17.           With .Pictures.Insert(fd & fs)
    
18.             .Top = A.Top: .Left = A.Left: .Height = A.Height: .Width = A.Width
    
19.           End With
    
20.        End If
    
21.        Next
    
22.     Next
    
23. Next
    
24. End With
    
25. End Sub

複製代碼

jackyliu

1. 可以幫我解釋一下嗎? 不太了解耶
2. 可圖片有52-T-1.jpg 和53.jpg 都無法插入第52和53列裡耶
感恩 !

Hsieh

52-T-1要在編號52的哪一欄?
53.jpg 要在編號53的哪一欄?

jackyliu

因圖片資料一直往下延伸關係,會有很多的ID 敘述, 所以會有很多列
52-T-1要在編號52的哪一欄?---> 欄位名稱NO  的第52筆圖片也就是第52行列的L欄位
53.jpg 要在編號53的哪一欄?---> 欄位名稱NO  的第53筆圖片也就是第5行列的H欄位


插入圖片做說明
H欄插入的定義=圖片名稱為整數,列如;52, 53, 54
I欄插入的定義=圖片名稱為 *-C     ,列如;52-C , 53-C, 54-C
J欄插入的定義=圖片名稱為 *-T     ,列如;52-T , 53-T, 54-T
K欄插入的定義=圖片名稱為 *-*-1 ,列如;52-C-1 , 53-T-1, 54-T-1
L欄插入的定義=圖片名稱為 *-T     ,列如;52-C-2 , 53-T-2, 54-T-2
M欄插入的定義=圖片名稱為 *-T    ,列如;52-C-3 , 53-T-3, 54-T-3

Hsieh

回復 5# jackyliu


    H2、I2的C、F並沒有在圖片檔名的編號規則內嗎?
不然為何53.jpg  會在H欄位?
請在各儲存格位置填入圖片檔名，以釐清命名規則與表格位置的關係

jackyliu

回復 6# Hsieh


如附件說明!
感謝您

Hsieh

回復 7# jackyliu

1. Sub Ex()
   
2. Set d = CreateObject("Scripting.Dictionary")
   
3. fd = ThisWorkbook.Path & "\" '圖檔目錄
   
4. fs = Dir(fd & "*.jpg")
   
5. Do Until fs = ""
   
6. If InStr(fs, "-") = 0 Then '只有數值
   
7.    d(fs) = "H" & Val(fs) + 2 '因為在第列所以加2
   
8.    ElseIf Len(fs) - Len(Replace(fs, "-", "")) = 1 Then '只有1個分隔符號
   
9.    '第2碼為C就是I欄，否則就在J欄
   
10.      If Split(fs, "-")(1) = "C" Then d(fs) = "I" & Val(fs) + 2 Else d(fs) = "J" & Val(fs) + 2
    
11.    Else
    
12.    '第3碼是1就在K欄，2就在L欄，其餘在M欄
    
13.    k = IIf(Split(fs, "-")(2) = 1, "K", IIf(Split(fs, "-")(2) = 2, "L", "M"))
    
14.    d(fs) = k & Val(fs) + 2
    
15. End If
    
16. fs = Dir
    
17. Loop
    
18. With Sheet1
    
19. .Pictures.Delete '清除所有圖片
    
20. Application.ScreenUpdating = False
    
21. For Each ky In d.keys
    
22.    Set A = .Range(d(ky)) '圖片插入的位置
    
23.       With .Pictures.Insert(fd & ky) '插入圖檔
    
24.          .Top = A.Top
    
25.          .Left = A.Left
    
26.          .Height = A.Height
    
27.          .Width = A.Width
    
28.        End With
    
29. Next
    
30. End With
    
31. Application.ScreenUpdating = True
    
32. End Sub

複製代碼

jackyliu

板大  好強....
感謝您的幫忙

另外一問 圖片大小好像沒看到有設定,可圖片又可符合需求  圖片大小 高度2.7cm、寬度3.6cm
程式裡只有這樣寫 (  Height = A.Height), 什麼原因可以讓圖片 符合需求  圖片大小

Hsieh

回復 9# jackyliu
設定成儲存格大小