伊莉討論區
標題:
VBA 收尋萬用字元問題
[打印本頁]
作者:
box299
時間:
2018-7-11 12:51 PM
標題:
VBA 收尋萬用字元問題
本帖最後由 darkjack 於 2018-7-13 06:39 AM 編輯
各位大神小弟一事請教!!
我有一個Excel VBA可以重指定資料夾抓取圖檔並匯入
但是該檔案只能抓取檔案全名(例如:1234.JPG)
不能以萬用字元抓取檔名(例如:*34.jpg)
可否請各位大神們賜教!!
-------------------------------------------------------------------------------------------------
Private Sub cmdMerge_Click()
Dim a, b, c As Integer '宣告a,b,c為整數
Dim objsheet As Worksheet
WorkName = Excel.ActiveWorkbook.Name '此檔案名稱
i = 6
Z = 1
picHeight = Range("b1")
picWidth = Range("b2")
picColumn = Range("b3")
picAngle = Range("b4")
'將之前產生的圖片清除
Sheet3.Activate
Sheet3.Shapes.SelectAll
Selection.Delete
While Sheet1.Range("b" & i) <> ""
FilePath = Sheet1.Range("a" & i)
Filename = Sheet1.Range("b" & i)
If FilePath = "" Then
Fullpath = Excel.Workbooks(WorkName).Path & "*" & Filename
Else
If Right(FilePath, 1) = "*" Then
Fullpath = FilePath & Filename
Else
Fullpath = FilePath & "*" & Filename
End If
End If
'檢查檔案是否存在
If Dir(Fullpath) <> "" Then
Sheet3.Activate
Sheet3.Range(picColumn & Z).Select
Set shpPic = Excel.ActiveSheet.Shapes.AddPicture(Fullpath, True, True, Selection.Left, Selection.Top, -1, -1)
If picHeight > 0 Then
shpPic.Height = 28.5 * picHeight
'調整列高度
Sheet3.Rows(Z).RowHeight = 28.5 * picHeight
End If
If picWidth > 0 Then
shpPic.Width = 28.5 * picWidth
End If
shpPic.Rotation = picAngle
Selection.Cut '2007才需要底下這樣作
Sheet3.Range(picColumn & Z).Select
ActiveSheet.Paste
Else
MsgBox "檔案:" & Fullpath & "不存在,請查看是否有拼錯字"
End If
i = i + 1 '讀取下一個名稱
Z = Z + 1
Wend
MsgBox "執行完成", vbOKOnly, ""
End Sub
複製代碼
作者:
tryit244178
時間:
2018-7-11 04:50 PM
本帖最後由 tryit244178 於 2018-7-11 06:38 PM 編輯
改用FileSystemObject
參考這篇
https://tw.answers.yahoo.com/question/index?qid=20090504000010KK10224
作者:
Waroger
時間:
2018-7-12 06:08 PM
Private Sub CommandButton1_Click()
p = Dir("D:\*34.jpg", vbNormal)
Do While p <> ""
If p <> "." And p <> ".." Then
Debug.Print p
End If
p = Dir
Loop
End Sub
複製代碼
歡迎光臨 伊莉討論區 (http://ww956w.eyny.com/)
Powered by Discuz!