如何篩選圖片,並插入指定的欄位 - Excel程式區

jackyliu

中學生 Rank: 2

帖子: 72
主題: 13
精華: 0
積分: 90
點名: 0
作業系統: windows xp
軟體版本: office 2000
閱讀權限: 20
性別: 女
註冊時間: 2011-2-14
最後登錄: 2024-10-13

11^# 跳轉到 »

發表於 2011-2-16 21:30 | 只看該作者

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

TOP

jackyliu

中學生 Rank: 2

帖子: 72
主題: 13
精華: 0
積分: 90
點名: 0
作業系統: windows xp
軟體版本: office 2000
閱讀權限: 20
性別: 女
註冊時間: 2011-2-14
最後登錄: 2024-10-13

12^#

發表於 2011-2-18 22:26 | 只看該作者

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

TOP

Hsieh

超級版主 Rank: 8 Rank: 8

帖子: 4901
主題: 44
精華: 24
積分: 4916
點名: 248
作業系統: Windows 7
軟體版本: Office 20xx
閱讀權限: 150
性別: 男
來自: 台北
註冊時間: 2010-4-30
最後登錄: 2024-11-16

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

13^#

發表於 2011-2-18 22:54 | 只看該作者

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

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

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

學海無涯_不恥下問

TOP

jackyliu

中學生 Rank: 2

帖子: 72
主題: 13
精華: 0
積分: 90
點名: 0
作業系統: windows xp
軟體版本: office 2000
閱讀權限: 20
性別: 女
註冊時間: 2011-2-14
最後登錄: 2024-10-13

14^#

發表於 2011-2-19 03:17 | 只看該作者

本帖最後由 jackyliu 於 2011-2-19 06:37 編輯

[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欄

圖片說明如附圖

1.jpg (17.62 KB)

1.jpg (18.42 KB)

結果表示圖

TOP

Hsieh

超級版主 Rank: 8 Rank: 8

帖子: 4901
主題: 44
精華: 24
積分: 4916
點名: 248
作業系統: Windows 7
軟體版本: Office 20xx
閱讀權限: 150
性別: 男
來自: 台北
註冊時間: 2010-4-30
最後登錄: 2024-11-16

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

15^#

發表於 2011-2-19 11:28 | 只看該作者

本帖最後由 Hsieh 於 2011-2-19 11:33 編輯

回復 14# jackyliu

Sub Ex()
Set d = CreateObject("Scripting.Dictionary")
fd = ThisWorkbook.Path & "\" '圖檔目錄
fs = Dir(fd & "*.jpg")
Do Until fs = ""
If InStr(fs, "-") = 0 Then '只有數值
d(fs) = "H" & Val(fs) + 2 '因為在第列所以加2
ElseIf Len(fs) - Len(Replace(fs, "-", "")) = 1 Then '只有1個分隔符號
'第2碼為C就是I欄，否則就在J欄
If Split(fs, "-")(1) = "C" Then d(fs) = "I" & Val(fs) + 2 Else d(fs) = "J" & Val(fs) + 2
Else
'第3碼是1就在K欄，2就在L欄，其餘在M欄
ar = Split(fs, "-")
p = IIf(ar(1) = "C", Asc("K"), Asc("L")) '第2碼是C就傳回"K"的字元碼，第2碼是T就傳回"L"的字元碼給變數p
k = Chr(Val(ar(2)) + p) '字串變數k的值是第3碼+p對應到的字串(就是欄位)
d(fs) = k & Val(fs) + 2
End If
fs = Dir
Loop
With Sheets("Sheet1")
.Pictures.Delete '清除所有圖片
Application.ScreenUpdating = False
For Each ky In d.keys
Set A = .Range(d(ky)) '圖片插入的位置
With .Pictures.Insert(fd & ky) '插入圖檔
.ShapeRange.LockAspectRatio = msoFalse '解除長寬比例
.Top = A.Top
.Left = A.Left
.Height = A.Height
.Width = A.Width
End With
Next
End With
Application.ScreenUpdating = True
End Sub

複製代碼

學海無涯_不恥下問

TOP

jackyliu

中學生 Rank: 2

帖子: 72
主題: 13
精華: 0
積分: 90
點名: 0
作業系統: windows xp
軟體版本: office 2000
閱讀權限: 20
性別: 女
註冊時間: 2011-2-14
最後登錄: 2024-10-13

16^#

發表於 2011-2-19 22:12 | 只看該作者

本帖最後由 jackyliu 於 2011-2-19 22:13 編輯

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

如附件!

pic.rar (728.4 KB)

TOP

Hsieh

超級版主 Rank: 8 Rank: 8

帖子: 4901
主題: 44
精華: 24
積分: 4916
點名: 248
作業系統: Windows 7
軟體版本: Office 20xx
閱讀權限: 150
性別: 男
來自: 台北
註冊時間: 2010-4-30
最後登錄: 2024-11-16

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

17^#

發表於 2011-2-20 01:27 | 只看該作者

回復 16# jackyliu

Sub Ex()
Set d = CreateObject("Scripting.Dictionary")
fd = ThisWorkbook.Path & "\" '圖檔目錄
fs = Dir(fd & "*.jpg")
Do Until fs = ""
If InStr(fs, "-") = 0 Then '只有數值
d(fs) = "H" & Val(fs) + 2 '因為在第列所以加2
ElseIf Len(fs) - Len(Replace(fs, "-", "")) = 1 Then '只有1個分隔符號
'第2碼為C就是I欄，否則就在J欄
V = Split(fs, "-")(1)
If Split(fs, "-")(1) Like "C*" Then d(fs) = "I" & Val(fs) + 2 Else d(fs) = "J" & Val(fs) + 2
Else
'第3碼是1就在K欄，2就在L欄，其餘在M欄
ar = Split(fs, "-")
p = IIf(ar(1) = "C", Asc("K"), Asc("L")) '第2碼是C就傳回"K"的字元碼，第2碼是T就傳回"L"的字元碼給變數p
k = Chr(Val(ar(2)) * 2 + p) '字串變數k的值是第3碼+p對應到的字串(就是欄位)
d(fs) = k & Val(fs) + 2
End If
fs = Dir
Loop
With Sheets("Sheet1")
.Pictures.Delete '清除所有圖片
Application.ScreenUpdating = False
For Each ky In d.keys
Set A = .Range(d(ky)) '圖片插入的位置
With .Pictures.Insert(fd & ky) '插入圖檔
.ShapeRange.LockAspectRatio = msoFalse '解除長寬比例
.Top = A.Top
.Left = A.Left
.Height = A.Height
.Width = A.Width
End With
Next
End With
Application.ScreenUpdating = True
End Sub

複製代碼

學海無涯_不恥下問

TOP

jackyliu

中學生 Rank: 2

帖子: 72
主題: 13
精華: 0
積分: 90
點名: 0
作業系統: windows xp
軟體版本: office 2000
閱讀權限: 20
性別: 女
註冊時間: 2011-2-14
最後登錄: 2024-10-13

18^#

發表於 2011-2-21 21:02 | 只看該作者

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

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

TOP

Hsieh

超級版主 Rank: 8 Rank: 8

帖子: 4901
主題: 44
精華: 24
積分: 4916
點名: 248
作業系統: Windows 7
軟體版本: Office 20xx
閱讀權限: 150
性別: 男
來自: 台北
註冊時間: 2010-4-30
最後登錄: 2024-11-16

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

19^#

發表於 2011-2-21 22:14 | 只看該作者

本帖最後由 Hsieh 於 2011-2-21 22:26 編輯

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

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

學海無涯_不恥下問

TOP

jackyliu

中學生 Rank: 2

帖子: 72
主題: 13
精華: 0
積分: 90
點名: 0
作業系統: windows xp
軟體版本: office 2000
閱讀權限: 20
性別: 女
註冊時間: 2011-2-14
最後登錄: 2024-10-13

20^#

發表於 2011-2-22 20:37 | 只看該作者

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

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

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

TOP

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

[收藏此主題] [關注此主題的新回復]

[通過 QQ、MSN 分享給朋友]