返回列表下一主題上一主題發帖

[發問] 不固定的搜尋路徑

man65boy

中學生 Rank: 2

帖子: 169
主題: 39
精華: 0
積分: 252
點名: 0
作業系統: XP
軟體版本: 2003
閱讀權限: 20
註冊時間: 2011-4-17
最後登錄: 2020-7-17

2012龍年全勤獎章 2011兔年全勤獎章

1^# 跳轉到 » 倒序看帖

打印

字體大小: tT

發表於 2015-11-25 14:10 | 只看該作者

[發問] 不固定的搜尋路徑

若是"圖片資料夾"路徑，在不是很固定的路徑讀取的話，沒法執行檔案讀取，例如:有可會放在dropbox雲端，也有可能放在隨身硬碟或任何電腦的磁碟裡，要怎樣才能只讀取特定資料夾照片資料，不用給他正確的路徑，因為路徑會變來變去，唯一不變的是檔名"圖片的資料夾"，請老師們幫忙解題，謝謝!!!
附檔:

20151125.rar (756.34 KB)
Sub Ex()
Dim xPath As String, xFile As String, Sp As Integer, Cz As Integer, G As Long, K As Integer, Mh As Integer
Dim ii As Integer
xPath = "D:\mydata\Desktop\新增資料夾 (2)\圖片資料夾\"                '圖片的資料夾
'Dir 函數傳回一個 String ，用以表示合乎條件、檔案屬性、磁碟標記的一個檔案名稱、或目錄、檔案夾名稱。
xFile = Dir(xPath & "*.jpg")          '圖片的副檔名為jpg
xFile = Dir(xPath & "*.*")          '圖片的資料夾都是圖片檔
With ActiveSheet                      '作用中的工作表
      Sp = 35 '水平
      Cz = 160  '垂直
      G = 0.1 '高
      K = 170    '寬
      Mh = 4    '每行
      .Pictures.Delete                   '刪除所有圖片
      .[a:a] = ""                      '清除 A欄資料
      ii = 1                            '設定為1
      Application.ScreenUpdating = False
      Do
         .Cells(ii, 1).Select          '選擇A欄的第 ii 儲存格(ActiveCell :作用中的儲存格)
         .Cells(ii, 1) = xFile          '寫上檔名
         With .Pictures.Insert(xPath & xFile)          '插入圖片
            .Left = ActiveCell.Offset(, 1).Left       '插入圖片的左端位置是: ActiveCell 右移2欄的左端
            .Top = ActiveCell.Offset(, 1).Top          '插入圖片的上端位置是: ActiveCell 右移2欄的上端
            .Width = 250                               '設定插入圖片的寬度190
            .Height = 150                               '設定插入圖片的高度143
            ActiveCell.Offset(, 2).ColumnWidth = 30 '設定插入圖片所在儲存格的寬
            ActiveCell.Offset(, 2).RowHeight = .Height '設定插入圖片所在儲存格的高
         End With
         xFile = Dir                   '繼續尋找下一個檔案
         ii = ii + 1                   'A欄的第 ii 儲存格往下一列
      Loop Until xFile = ""             '離開 Do 迴圈的條件是: 找不到檔案
      .[A1].Select
      Selection.EntireColumn.AutoFit    'AutoFit 方法將範圍中的欄寬和列高調整為最適當的值
      Application.ScreenUpdating = True 'ScreenUpdating 屬性定如果螢幕更新功能是開啟的則為 True。讀/寫 Boolean
End With

End Sub