Board logo

標題: [發問] 指定主資料夾,將其副資料夾一一載入各sheet(含改name)(已解決,感謝) [打印本頁]
作者: cmo140497    時間: 2011-7-8 08:10     標題: 指定主資料夾,將其副資料夾一一載入各sheet(含改name)(已解決,感謝)

本帖最後由 cmo140497 於 2011-7-12 17:34 編輯

Dear 各位版主 :
小弟用vba寫將指定之資料夾內之圖片一一載入至指定欄位,但如果主資料夾內之副資料夾太多,得一個一個開啟-載入-移動sheet,不知如何可一次開啟
程式,指定主資料夾,將其副資料夾一一載入各sheet(含改name),及載入圖片,謝謝!
作者: GBKEE    時間: 2011-7-8 11:06

本帖最後由 GBKEE 於 2011-7-8 11:09 編輯

回復 1# cmo140497
試試看
  1. Sub Ex()
  2.     Dim Fs As Object, E, i As Integer, P, ii As Integer
  3.     With CreateObject("Scripting.FileSystemObject").GetFolder("d:\相片\") '<-修改為你要查詢之資料夾
  4.         i = 1
  5.         For Each E In .SubFolders
  6.             If i > ActiveWorkbook.Sheets.Count Then
  7.                 Sheets.Add(, Sheets(Sheets.Count)).Name = E.Name
  8.             Else
  9.                 Sheets(i).Name = E.Name
  10.             End If
  11.             ii = 1
  12.             For Each P In E.Files
  13.               If InStr(UCase(P.Name), ".JPG") Then
  14.                 With Sheets(i).Pictures.Insert(P)
  15.                     .Top = Cells(ii, 2).Top
  16.                     .Left = Cells(ii, 2).Left
  17.                     .Width = 50
  18.                     .Height = 50
  19.                 End With
  20.                 ii = ii + 5
  21.             End If
  22.         Next
  23.             i = i + 1
  24.         Next
  25.     End With
  26. End Sub
複製代碼
作者: cmo140497    時間: 2011-7-8 12:38

版主實在太神了,一次就解決我的困擾,另請教版主
InStr 函數   傳回在某字串中一字串的最先出現位置，此位置為 Variant (Long)。
Ucase 函數 傳回一個 Variant (String)，所含為轉成大寫之字串
可否請版主幫小弟解釋一下這些函數的用意
另如果可以用Application.FileDialog(msoFileDialogFolderPicker)來指定資料夾的話,要如何寫這段程式?
及將圖片檔案名稱並行載入另一欄位,不知是否可行?
作者: GBKEE    時間: 2011-7-8 13:42

回復 3# cmo140497
If InStr(UCase(P.Name), ".JPG")  Then -> If InStr(UCase(P.Name), ".JPG")=True  Then
P.Name 在此程式中->依序傳回每一資料夾中的File的名稱
InStr的比對是有分大小寫的,如InStr有比對到時>0   系統將>0的數值轉換成 True
試試看
  1. Sub Ex()
  2.     Dim Fs As Object, E, i As Integer, P, ii As Integer
  3.     Dim xlPath As String
  4.     With Application.FileDialog(msoFileDialogFolderPicker)
  5.         .AllowMultiSelect = False    'True 如果允許使用者從檔案對話方塊選取多個檔案
  6.         .Show
  7.         If .SelectedItems.Count = 0 Then Exit Sub
  8.         xlPath = .SelectedItems(1)
  9.     End With
  10.     With CreateObject("Scripting.FileSystemObject").GetFolder(xlPath)
  11.         i = 1
  12.         For Each E In .SubFolders
  13.             If i > ActiveWorkbook.Sheets.Count Then
  14.                 Sheets.Add(, Sheets(Sheets.Count)).Name = E.Name
  15.             Else
  16.                 Sheets(i).Name = E.Name
  17.             End If
  18.             ii = 1
  19.             For Each P In E.Files
  20.               If InStr(UCase(P.Name), ".JPG") Then
  21.                 With Sheets(i).Pictures.Insert(P)
  22.                     .Top = Cells(ii, 2).Top
  23.                     .Left = Cells(ii, 2).Left
  24.                     .Width = 50
  25.                     .Height = 50
  26.                 End With
  27.                 ii = ii + 5
  28.             End If
  29.         Next
  30.             i = i + 1
  31.         Next
  32.     End With
  33. End Sub
複製代碼
作者: cmo140497    時間: 2011-7-8 16:19

Dear 版主 :
實在太感謝版主了,小弟還是有一疑惑
InStr 函數   傳回在某字串中一字串的最先出現位置，此位置為 Variant (Long)。
If InStr(UCase(P.Name), ".JPG")=True  Then
P.Name 在此程式中->依序傳回每一資料夾中的File的名稱
兩者的解釋似乎有差異,傳回某字串指的是所指定之路徑名稱字串嗎?
另外如果要同時載入圖片時,順帶於另一欄位載入圖片檔名,程式碼該如何撰寫?謝謝!
作者: GBKEE    時間: 2011-7-8 19:34

本帖最後由 GBKEE 於 2011-7-8 19:37 編輯

回復 5# cmo140497
某字串 ->P.Name ,  一字串->".JPG"  
If InStr(UCase(某字串), "一字串") >0  Then   ->  比對到了  P 為 JPG格式的圖片檔

For Each P In E.Files
       If InStr(UCase(P.Name), ".JPG") Then
             With Sheets(i)
                    . Cells(ii, 1) = P.Name             'A欄輸入 圖片檔案名稱  
                   '.Cells(ii, 1) = P                        'A欄輸入  圖片檔案完整路徑名稱            
                  .Pictures.Insert(P).Top =.Cells(ii, 2).Top          'B欄 插入 圖片檔  
                  .Pictures.Insert(P).Left =.Cells(ii, 2).Left
                  .Pictures.Insert(P).Width = 50
                  .Pictures.Insert(P).Height = 50
             End With
             ii = ii + 5
      End If
Next
作者: cmo140497    時間: 2011-7-11 08:58

感謝版主不厭其煩地指正,太感謝您了!



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)