c_c_lai

回復 19# GBKEE
GBKEE 版大， 早安!
我實際測了一陣子，發現 一執行到 With ActiveSheet.Pictures.Insert(f)
這一行便出現 104 的錯誤訊息， 經檢查語法也沒錯，就是會有錯誤訊息。
也令我百思不解。 我另外將其中 GetFolder 的處裡模組放入到另一支程式
裏測試都非常正常，我將程式碼  (在ThisWorkbook執行) 附上讓您參考。

1. Option Explicit
   
2. 
   
3. Sub Ex()
   
4.     Dim fs As Object, f As Variant, e As Variant
   
5.     Dim j As Integer, MyPath As String, MyFile As String
   
6.    
   
7.     j = 2
   
8.     MyPath = ActiveWorkbook.Path & "\My Pictures\"
   
9.    
   
10.     Application.ScreenUpdating = False
    
11.    
    
12.     Set fs = CreateObject("Scripting.FileSystemObject").GetFolder(MyPath)
    
13.     For Each e In fs.subfolders  ' 資料夾集合物件 e = "D:\Workspaces\DATA\Excel 範例集錦\TXT\2012-12-12\14"
    
14.         '  For Each f In e.Files  ' 檔案集合物件 f = "D:\Workspaces\DATA\Excel 範例集錦\TXT\2012-12-12\14\Winter.jpg"
    
15.         With Sheets("工作表1")
    
16.             .Pictures.Delete
    
17.             While Cells(j, "C") <> ""
    
18.                 If UCase(.Cells(j, "C")) Like "*ABCD*" Then  '字串中有"ABCD"
    
19.                     'UCase 函數 傳回一個 Variant (String)，所含為轉成大寫之字串。
    
20.                     .Cells(j, "D").Select
    
21.                                        
    
22.                      Selection.RowHeight = 100
    
23.                      Selection.ColumnWidth = 25
    
24.                                             
    
25.                      On Error Resume Next
    
26.                      '   MyFile = Dir(e & "\*" & Cells(j, "C") & "*.*", vbDirectory)
    
27.                      MyFile = Dir(e & "\*" & Cells(j, "C") & "*.*")
    
28.                      If MyFile <> "" Then
    
29.                          '  With .Pictures.Insert(MyPath & MyFile)
    
30.                          With .Pictures.Insert(e & "\" & MyFile)
    
31.                              .Top = Cells(j, "D").Top
    
32.                              .Left = Cells(j, "D").Left
    
33.                              .Height = 90
    
34.                              .Width = 120
    
35.                              .Cells(j, "D").RowHeight = .Height
    
36.                              .Cells(j, "D").ColumnWidth = .Width / 5.5
    
37.                              '  .ShapeRange.LockAspectRatio = msoTrue
    
38.                              '  在調整圖案大小時，可以分別地調整圖案的長度和寬度
    
39.                              '  .ShapeRange.LockAspectRatio = msoFalse
    
40.                              '  .ShapeRange.Height = IIf(.ShapeRange.Height > 98, 98, .ShapeRange.Height)
    
41.                              '  .ShapeRange.Width = IIf(.ShapeRange.Width > 150, 150, .ShapeRange.Width)
    
42.                              '  .ShapeRange.Rotation = 0#
    
43.                              '  .ShapeRange.IncrementLeft 2#
    
44.                              '  .ShapeRange.IncrementTop 1#
    
45.                              '  .Placement = xlMoveAndSize
    
46.                              '  .PrintObject = True
    
47.                          End With
    
48.                          .Cells(j, "E") = MyFile
    
49.                      End If
    
50.                 End If
    
51.                 j = j + 1
    
52.             Wend
    
53.             .Range("C2").Select
    
54.         End With
    
55.         '  Next    '  For Each f In e.Files
    
56.     Next           '  For Each e In fs.subfolders
    
57.     Application.ScreenUpdating = True
    
58. End Sub

複製代碼

c_c_lai

回復 21# GBKEE

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

複製代碼

下載 (71.11 KB)

2012-12-13 11:37

供做測試用：   插入圖片2.rar (9.79 KB)

下載次數: 5

2012-12-13 11:38

c_c_lai

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

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

1.         With ActiveSheet.Pictures.Insert(f)

複製代碼

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

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

複製代碼

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