jackyliu

感謝您的 熱心協助,　感激 ~

jackyliu

1. 版大 可以幫我解釋這兩行嗎?
2. 另外 可以幫我加上排序插入K欄以後的欄位嗎? (ex : 1-C-0, 1-C-1, 1-T-1, 1-T-2)

If InStr(fs, "-") = 0 Then '只有數值
   d(fs) = "H" & Val(fs) + 2 '因為在第列所以加2

Hsieh

回復 12# jackyliu
If InStr(fs, "-") = 0 Then '只有數值
用INSTR函數測試看看圖片檔名是否有"-"號，因為只有數值時才沒有"-"號

d(fs) = "H" & Val(fs) + 2 '因為在第列所以加2
字典物件是用來儲存檔名對應的位址， Val(fs)會得到NO值，而NO的1是從第3列開始，所以列位要加2


至於你要增加欄位的問題，又回到之前的重點:檔名跟儲存欄位的對應規則
要自己清楚對應規則，然後在判斷式中一條件來寫入字典物件

jackyliu

[attach]4793[/attach]事由: 因檔檔名有 1-C-0, 1-C-1, 1-T-1 , 1-T-2 .....   ;需分別插入至K欄~R欄

我想說改成 第3碼編碼成0~7 ,分別插入至K欄~R欄, 所以往底下這一行動手,一直無法執行,不知道為什麼不行?
改法 -->IIf(Split(fs, "-")(8) = 0, "K",IIf(Split(fs, "-")(8) = 1, "L",IIf(Split(fs, "-")(8) = 2, "M",IIf(Split(fs, "-")(8) = 3, "N", "O"))
上面是哪出錯了,可否幫忙一下 ! 謝謝 !


原程式Code:
k = IIf(Split(fs, "-")(2) = 1, "K", IIf(Split(fs, "-")(2) = 2, "L", "M"))-->第3碼是1就在K欄，2就在L欄，其餘在M欄

圖片說明如附圖

Hsieh

回復 14# 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.    ar = Split(fs, "-")
    
14.    p = IIf(ar(1) = "C", Asc("K"), Asc("L")) '第2碼是C就傳回"K"的字元碼，第2碼是T就傳回"L"的字元碼給變數p
    
15.    k = Chr(Val(ar(2)) + p) '字串變數k的值是第3碼+p對應到的字串(就是欄位)
    
16.    d(fs) = k & Val(fs) + 2
    
17. End If
    
18. fs = Dir
    
19. Loop
    
20. With Sheets("Sheet1")
    
21. .Pictures.Delete '清除所有圖片
    
22. Application.ScreenUpdating = False
    
23. For Each ky In d.keys
    
24.    Set A = .Range(d(ky)) '圖片插入的位置
    
25.       With .Pictures.Insert(fd & ky) '插入圖檔
    
26.          .ShapeRange.LockAspectRatio = msoFalse '解除長寬比例
    
27.          .Top = A.Top
    
28.          .Left = A.Left
    
29.          .Height = A.Height
    
30.          .Width = A.Width
    
31.        End With
    
32. Next
    
33. End With
    
34. Application.ScreenUpdating = True
    
35. End Sub

複製代碼

jackyliu

版大 目前測試 11張圖片 ,應該會分別差入 11個 儲存格 (H 欄~R欄)
結果 發現 有些圖片 重疊情行,不知哪裡出錯了?
請您 幫忙測試一下, 感謝~

如附件!

Hsieh

回復 16# 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.    V = Split(fs, "-")(1)
    
11.      If Split(fs, "-")(1) Like "C*" Then d(fs) = "I" & Val(fs) + 2 Else d(fs) = "J" & Val(fs) + 2
    
12.    Else
    
13.    '第3碼是1就在K欄，2就在L欄，其餘在M欄
    
14.    ar = Split(fs, "-")
    
15.    p = IIf(ar(1) = "C", Asc("K"), Asc("L")) '第2碼是C就傳回"K"的字元碼，第2碼是T就傳回"L"的字元碼給變數p
    
16.    k = Chr(Val(ar(2)) * 2 + p) '字串變數k的值是第3碼+p對應到的字串(就是欄位)
    
17.    d(fs) = k & Val(fs) + 2
    
18. End If
    
19. fs = Dir
    
20. Loop
    
21. With Sheets("Sheet1")
    
22. .Pictures.Delete '清除所有圖片
    
23. Application.ScreenUpdating = False
    
24. For Each ky In d.keys
    
25.    Set A = .Range(d(ky)) '圖片插入的位置
    
26.       With .Pictures.Insert(fd & ky) '插入圖檔
    
27.          .ShapeRange.LockAspectRatio = msoFalse '解除長寬比例
    
28.          .Top = A.Top
    
29.          .Left = A.Left
    
30.          .Height = A.Height
    
31.          .Width = A.Width
    
32.        End With
    
33. Next
    
34. End With
    
35. Application.ScreenUpdating = True
    
36. End Sub

複製代碼

jackyliu

耶 ... 感覺對了耶~
板大  感恩

不知道 可插入到200.jpg 或是200-C-0.jpg 程式code 哪裡 可以看出來? 有限制嗎?
若是要開啟execl 就直接啟動巨集 (開啟execl 圖片就自動插入,要加什麼指令;還需要將程式放在模組裡嗎?)

Hsieh

用OPEN事件程序驅動即可開啟檔案就載入圖片
Sub Ex()
改成Sub auto_open()
把所有程式碼放在一般模組


檔案名稱只要是根據你的描述條件命名應該就沒錯

jackyliu

所以 程式可讀到圖片名稱200.jpg 或是200-C-0.jpg ,所以是沒有比數限制...

另外..圖片插入後,另存新檔時,新儲存的檔案,會聯帶VBA  程式Code 帶至 新檔案耶;
可否另存檔案時 ,不要也將VBA  程式Code 存到新檔案 ( 新檔案不要有 VBA  程式Code ) 要如作 ?

什麼方式都可以 ,麻煩 指教一下 !