返回列表 上一主題 發帖

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

c_c_lai

帖子
2035 
主題
24 
精華
0 
積分
2031 
點名
0  
作業系統
Win7 
軟體版本
Office2010 
閱讀權限
100 
性別
男 
註冊時間
2012-3-22 
最後登錄
2024-2-1 
1# 跳轉到 »
發表於 2012-12-13 11:00 | 顯示全部帖子
回復 19# GBKEE
GBKEE 版大， 早安!
我實際測了一陣子，發現 一執行到 With ActiveSheet.Pictures.Insert(f)
這一行便出現 104 的錯誤訊息， 經檢查語法也沒錯，就是會有錯誤訊息。
也令我百思不解。 我另外將其中 GetFolder 的處裡模組放入到另一支程式
裏測試都非常正常，我將程式碼  (在ThisWorkbook執行) 附上讓您參考。
  1. Option Explicit

  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
複製代碼

TOP

c_c_lai

帖子
2035 
主題
24 
精華
0 
積分
2031 
點名
0  
作業系統
Win7 
軟體版本
Office2010 
閱讀權限
100 
性別
男 
註冊時間
2012-3-22 
最後登錄
2024-2-1 
2#
發表於 2012-12-13 11:39 | 顯示全部帖子
回復 21# GBKEE
  1. Option Explicit

  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
複製代碼

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

TOP

c_c_lai

帖子
2035 
主題
24 
精華
0 
積分
2031 
點名
0  
作業系統
Win7 
軟體版本
Office2010 
閱讀權限
100 
性別
男 
註冊時間
2012-3-22 
最後登錄
2024-2-1 
3#
發表於 2012-12-13 14:48 | 顯示全部帖子
回復  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 的錯誤訊息。

TOP

        靜思自在 : 得理要饒人，理直要氣和。
返回列表 上一主題