VBA萬用字元收尋不到檔案時無法停止程式

box299

請問一下各位大神!

我想問一下!我這個程式碼只要在檔案夾內有所收尋的圖片都能正常執行，但當收尋的圖片不在資料夾內卻無法停止收巡，導致軟體會死當，有大大們可以幫我看看哪裡出了問題嗎?

Private Sub cmdMerge_Click()

Dim a, b, c As Integer '宣告a,b,c為整數
Dim objsheet As Worksheet
WorkName = Excel.ActiveWorkbook.Name '此檔案名稱

i = 6
...

瀏覽完整內容，請先 註冊 或 登入會員

tvmateiii

你應該自己嘗試看看捉臭蟲
提示你

找不到檔案的時候
是否要跳出迴圈呢

你的 For Next 有好好配對嗎

我實在看不懂　
Exit For 在 Next 止面代表什麼意思

＝＝＝＝＝＝＝＝＝＝＝
Exit For
Next
Wend


MsgBox "執行完成", vbOKOnly, ""
...

瀏覽完整內容，請先 註冊 或 登入會員

Waroger

這是依照你上個問題提供的檔案去修改的，看是否符合你所需。

1. Private Sub cmdMerge_Click()
   
2.     Dim fs As Object, fd As Object, f As Object, b As Boolean, s As String
   
3.    
   
4.     WorkName = Excel.ActiveWorkbook.Name '此檔案名稱
   
5.    
   
6.     i = 6
   
7.     Z = 1
   
8.    
   
9.     picHeight = Range("b1")
   
10.     picWidth = Range("b2")
    
11.     picColumn = Range("b3")
    
12.     picAngle = Range("b4")
    
13.    
    
14.     '將之前產生的圖片清除
    
15.     Sheet3.Activate
    
16.     Sheet3.Shapes.SelectAll
    
17.     Selection.Delete
    
18.     '建立FileSystemObject物件
    
19.     Set fs = CreateObject("Scripting.FileSystemObject")
    
20.    
    
21.     While Sheet1.Range("b" & i) <> ""
    
22.           Filepath = Sheet1.Range("a" & i)
    
23.           Filename = Sheet1.Range("b" & i)
    
24.           If Filepath = "" Then Filepath = Excel.Workbooks(WorkName).Path
    
25.           Filepath = IIf(Right(Filepath, 1) = "\", Filepath, Filepath & "\")
    
26.           '指定fd到Folder物件
    
27.           Set fd = fs.GetFolder(Filepath)
    
28.           '列舉出此資料夾所有檔案
    
29.           b = False
    
30.           For Each f In fd.Files
    
31.               If f.Name Like "*" & Filename Then
    
32.                  Sheet3.Activate
    
33.                  Sheet3.Range(picColumn & Z).Select
    
34.                  Set shpPic = Excel.ActiveSheet.Shapes.AddPicture(f.Path, True, True, Selection.Left, Selection.Top, -1, -1)
    
35.                  If picHeight > 0 Then
    
36.                     shpPic.Height = 28.5 * picHeight
    
37.                    '調整列高度
    
38.                     Sheet3.Rows(Z).RowHeight = 28.5 * picHeight
    
39.                  End If
    
40.                  If picWidth > 0 Then shpPic.Width = 28.5 * picWidth
    
41.                  shpPic.Rotation = picAngle
    
42.                  Selection.Cut   '2007才需要底下這樣作
    
43.                  Sheet3.Range(picColumn & Z).Select
    
44.                  ActiveSheet.Paste
    
45.                  b = True
    
46.                  Z = Z + 1
    
47.               End If
    
48.           Next
    
49.           If Not b Then s = s & Filepath & "資料夾裡面找不到符合 *" & Filename & "的檔案!" & vbCrLf
    
50.           i = i + 1 '讀取下一個名稱
    
51.          
    
52.     Wend
    
53.     MsgBox "執行完成" & IIf(s = "", "", vbCrLf & s)
    
54. End Sub

複製代碼

...

瀏覽完整內容，請先 註冊 或 登入會員