如何插入資料夾中含子資料夾的圖片 - Excel程式區

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

21^# 跳轉到 »

發表於 2012-12-13 11:11 | 只看該作者

本帖最後由 GBKEE 於 2012-12-13 11:15 編輯

回復 20# c_c_lai
程序中用 On Error Resume Next 有時會找不出錯誤點的
看一下 19#

' MyFile = Dir(e & "\*" & Cells(j, "C") & "*.*") 改用了
If UCase(f) Like "*.JPG" Or UCase(f) Like "*.GIF" Or UCase(f) Like "*.BMP" Then
'預防不是圖片檔

複製代碼

TOP

c_c_lai

博士班 Rank: 6 Rank: 6

帖子: 2035
主題: 24
精華: 0
積分: 2031
點名: 0
作業系統: Win7
軟體版本: Office2010
閱讀權限: 100
性別: 男
註冊時間: 2012-3-22
最後登錄: 2024-2-1

22^#

發表於 2012-12-13 11:39 | 只看該作者

回復 21# GBKEE

Option Explicit
Sub Ex()
Dim fs, f, e As Variant, i As Integer, xCol As Integer
Sheets(1).Activate
ActiveSheet.Pictures.Delete
xCol = 3 '欄數
Set fs = CreateObject("Scripting.FileSystemObject").GetFolder("D:\2012-12-12")
'**檔案,資料夾的命名中: 不可有 / \ : * ? < > | 這些字元
For Each e In fs.subfolders '資料夾集合物件
i = 2 '列數
If Val(e.Name) >= [A1] And Val(e.Name) <= Range("B1") Then '如果我在A1輸入06 B1輸入12
'If e.Name >= 5 And e.Name <= 15 Then '5 到 10
For Each f In e.Files '檔案集合物件
If UCase(f) Like "*.JPG" Or UCase(f) Like "*.GIF" Or UCase(f) Like "*.BMP" Then
'預防不是圖片檔
i = i + 1
With ActiveSheet.Pictures.Insert(f)
.Top = Cells(i, xCol).Top
.Left = Cells(i, xCol).Left
.Height = 49.5
.Width = 49.5
Cells(i, xCol).RowHeight = .Height
Cells(i, xCol).ColumnWidth = .Width / 5.5
End With
End If
Next
xCol = xCol + 1 '欄數
End If
Next
End Sub

複製代碼

供做測試用：

插入圖片2.rar (9.79 KB)

TOP

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

23^#

發表於 2012-12-13 12:09 | 只看該作者

回復 22# c_c_lai
2003版沒有錯誤!!
錯誤點前 Debug.Print f 看看: 是哪個圖檔,將他刪掉試試

TOP

whirlwind963

小學生 Rank: 1

帖子: 29
主題: 7
精華: 0
積分: 42
點名: 0
作業系統: XP
軟體版本: OFFICE 2003
閱讀權限: 10
註冊時間: 2012-9-22
最後登錄: 2013-1-9

24^#

發表於 2012-12-13 14:18 | 只看該作者

回復 19# GBKEE
這次可以顯示出圖片了
感謝GBKEE大大的幫助

TOP

c_c_lai

博士班 Rank: 6 Rank: 6

帖子: 2035
主題: 24
精華: 0
積分: 2031
點名: 0
作業系統: Win7
軟體版本: Office2010
閱讀權限: 100
性別: 男
註冊時間: 2012-3-22
最後登錄: 2024-2-1

25^#

發表於 2012-12-13 14:48 | 只看該作者

回復 c_c_lai
2003版沒有錯誤!!
錯誤點前 Debug.Print f 看看: 是哪個圖檔,將他刪掉試試
GBKEE 發表於 2012-12-13 12:09

測出癥結了，問題出在 f 變數之使用上：

With ActiveSheet.Pictures.Insert(f)

複製代碼

會出現 1004 的錯誤訊息，需修正為：

With ActiveSheet.Pictures.Insert(e & "\" & f.Name)

複製代碼

如此看來，For Each f In e.Files 的 f 在 2003 它可以當成字串直接處理，
而在 2010 時， f 則視為一個物件 (Class)，此時如果直接使用它執行
With ActiveSheet.Pictures.Insert(f) 就會出現 1004 的錯誤訊息。

TOP

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

26^#

發表於 2012-12-13 15:03 | 只看該作者

回復 25# c_c_lai
謝謝:上了一課

TOP

whirlwind963

小學生 Rank: 1

帖子: 29
主題: 7
精華: 0
積分: 42
點名: 0
作業系統: XP
軟體版本: OFFICE 2003
閱讀權限: 10
註冊時間: 2012-9-22
最後登錄: 2013-1-9

27^#

發表於 2012-12-15 09:19 | 只看該作者

回復 26# GBKEE
再問一個問題....
時間點的問題已解決
但是又遇到一個問題了
目前的巨集只能抓到指定時間點下面的圖片
如果裡面還有子資料夾
那怎麼辦呢

TOP

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

28^#

發表於 2012-12-15 10:56 | 只看該作者

回復 25# c_c_lai
Dim f As Variant 這樣試試, 2007還有錯誤嗎?

回復 27# whirlwind963

Option Explicit
Dim i As Integer, xCol As Integer
Sub Ex()
Dim fs, f As Object, e As Object
Sheets(1).Activate
ActiveSheet.Pictures.Delete
Set fs = CreateObject("Scripting.FileSystemObject").GetFolder("D:\2012-12-12")
xCol = 3 '欄數
For Each e In fs.subfolders '資料夾集合物件
i = 1 '列數
子資料夾 e
xCol = xCol + 1 '欄數
Next
End Sub
Private Sub 子資料夾(資料夾 As Variant)
Dim fs As Object, f As Variant
Set fs = CreateObject("Scripting.FileSystemObject").GetFolder(資料夾)
For Each f In fs.Files '檔案:集合物件
If UCase(f) Like "*.JPG" Or UCase(f) Like "*.GIF" Or UCase(f) Like "*.BMP" Then
i = i + 1
With ActiveSheet.Pictures.Insert(f)
.Top = Cells(i, xCol).Top
.Left = Cells(i, xCol).Left
.Height = 49.5
.Width = 49.5
Cells(i, xCol).RowHeight = .Height
Cells(i, xCol).ColumnWidth = .Width / 5.5
End With
End If
Next
For Each f In fs.subfolders '資料夾:集合物件
i = i + 1
子資料夾 f '再度呼叫 (本程序)
Next
End Sub

複製代碼

TOP

whirlwind963

小學生 Rank: 1

帖子: 29
主題: 7
精華: 0
積分: 42
點名: 0
作業系統: XP
軟體版本: OFFICE 2003
閱讀權限: 10
註冊時間: 2012-9-22
最後登錄: 2013-1-9

29^#

發表於 2012-12-15 11:17 | 只看該作者

回復 28# GBKEE
我看懂了~
感謝~
跟4#的程式碼差了一點
Private Sub 子資料夾(TheFolder)
Dim fs As Object, f As Object
Set fs = CreateObject("Scripting.FileSystemObject").GetFolder(TheFolder)
=========================================================
Private Sub 子資料夾(資料夾 As Variant)
Dim fs As Object, f As Variant
Set fs = CreateObject("Scripting.FileSystemObject").GetFolder(資料夾)
可以請問上面跟下面的差別嗎

TOP

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

30^#

發表於 2012-12-15 11:35 | 只看該作者

回復 29# whirlwind963
是一樣的: 這引數 TheFolder 沒宣告型態就是 As Variant

Variant 資料型態
Variant 資料型態是所有沒被明確宣告為其他型

複製代碼

TOP

[發問] 如何插入資料夾中含子資料夾的圖片

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

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

[發問] 如何 插入 資料夾中含子資料夾的 圖片

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

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

[發問] 如何插入資料夾中含子資料夾的圖片