MsgBox 的問題

jesscc

請教各位先進一個問題，我要在Main活頁簿中按"開檔比對"按鈕開啟另外一個活頁簿Matl Request *.xls(*代表不同的日期)

1.如果"Matl Request *.xls"尚未開啟，就在 "開啟檔案對話框" 中將它開啟，順便把檔名貼在Main活頁簿中的Range("D1")，以便後續程式由此取得檔名，進行相關工作(Workbooks(Workbooks("Main").Sheets("MRP").[D3].Text).Sheets("sheet1").Range("B11:N22").Copy Workbooks("Main").Sheets("MRP").Range("B11:N22"))。
2.如果"Matl Request *.xls"已開啟，就不用顯示 "開啟檔案對話框" 直接抓取這個檔名貼在Main活頁簿中的Range("D1")，以便後續程式由此取得檔名，進行相關工作。

可是我的寫法好像沒什麼作用，不知道問題在哪裡?可以幫我看看嗎?謝謝!

test.rar (21.15 KB)

下載次數: 5

2011-5-7 12:24

Hsieh

回復 1# jesscc

1. Sub OpenFile1()
   
2. FileToOpen = Application.GetOpenFilename _
   
3. (Title:="開啟本週需求表", _
   
4. FileFilter:="Matl Request *.xls (*.xls),")
   
5. If FileToOpen = False Then
   
6. MsgBox "必須開啟 需求表，工作才能繼續!", 48, "檔案未開啟"
   
7. Exit Sub
   
8. Else
   
9. op = False
   
10. fn = Split(FileToOpen, "\")(UBound(Split(FileToOpen, "\")))
    
11. Var = MsgBox("確定是開啟這份需求表嗎?", 36, "請確認欲開啟之檔案")
    
12. If Var = 6 Then
    
13. For Each w In Windows '檢查檔案是否已開啟
    
14.    If w.Caption = fn Then op = True: Exit For
    
15. Next
    
16. If op = False Then Workbooks.Open Filename:=FileToOpen '如果視窗中沒有開啟需求表就開啟需求表
    
17. Set aw = Workbooks(fn) '將需求表設給物件變數以利後續使用
    
18. Workbooks("Main.xls").Activate
    
19. Sheets("MRP").Range("D1").Value = fn '將需求表檔名寫入儲存格
    
20. Else
    
21. End If
    
22. End If
    
23. 
    
24. End Sub

複製代碼

GBKEE

回復 1# jesscc
可是我的寫法好像沒什麼作用，不知道問題在哪裡?
Sub OpenFile1()
FileToOpen = Application.GetOpenFilename _
(Title:="開啟本週需求表", _
FileFilter:="Matl Request *.xls (*.xls),")
If FileToOpen = False Then
MsgBox "必須開啟 需求表，工作才能繼續!", 48, "檔案未開啟"
Exit Sub
Else
Var = MsgBox("確定是開啟這份需求表嗎?", 36, "請確認欲開啟之檔案")
'No  ->Var =7
'Yes->Var =6
If Var = 6 Then
Workbooks.Open Filename:=FileToOpen
Workbooks("Main.xls").Activate
Sheets("MRP").Range("D1").Value = FileToOpen
Else
End If
End If
End Sub

MsgBox 按鍵判斷

1. Sub Ex()
   
2.     A = MsgBox("確定是開啟這份需求表嗎?", vbYesNoCancel, "請確認欲開啟之檔案")
   
3.     If A = vbYes Then
   
4.         MsgBox "開啟檔案"
   
5.     ElseIf A = vbNo Then
   
6.         MsgBox "不開啟檔案"
   
7.     ElseIf A = vbCancel Then
   
8.         MsgBox "取消"
   
9.     End If
   
10. End Sub

複製代碼

jesscc

原來這麼複雜，本來還以為是很簡單的動作呢?
感謝 Hsieh 大!
不過剛剛測試，還是有一點小問題。如果我已經先打開了Matl Request *.xls，然後才在Main活頁簿中按"開檔比對"按鈕，結果還是會出現 "開啟檔案對話框" ，在這種情形下可以略過"開啟檔案對話框"，直接跳到我的工作嗎?

Hsieh

回復 4# jesscc

那你怎麼讓程式知道你想開的檔名是甚麼?
例如已有2個不同日期的類似檔名，要用哪一個?

jesscc

說得也是，我不知不覺就把人的思考帶進電腦裏了。
Hsieh 大大可以再幫我看一下嗎?
在最後，陣列轉移需求表資料的地方出現偵錯!可不可以幫我檢查一下是哪裡錯了嗎?是因為陣列無法轉移需求表裏的公式嗎?

1. Sub OpenFile1()
   
2. FileToOpen = Application.GetOpenFilename _
   
3. (Title:="開啟本週需求表", _
   
4. FileFilter:="Matl Request *.xls (*.xls),")
   
5. If FileToOpen = False Then
   
6. MsgBox "必須開啟 需求表，工作才能繼續!", 48, "檔案未開啟"
   
7. Exit Sub
   
8. Else
   
9. op = False
   
10. fn = Split(FileToOpen, "\")(UBound(Split(FileToOpen, "\")))
    
11. 'Var = MsgBox("確定是開啟這份需求表嗎?", 36, "請確認欲開啟之檔案")
    
12. 'If Var = 6 Then
    
13. For Each w In Windows '檢查檔案是否已開啟
    
14.    If w.Caption = fn Then op = True: Exit For
    
15. Next
    
16. If op = False Then Workbooks.Open FileName:=FileToOpen '如果視窗中沒有開啟需求表就開啟需求表
    
17. Set aw = Workbooks(fn) '將需求表設給物件變數以利後續使用
    
18. Workbooks("Main.xls").Activate
    
19. Sheets("MRP").Range("D1").Value = fn '將需求表檔名寫入儲存格
    
20. 'Else
    
21. End If
    
22. 
    
23. '陣列轉移需求表資料
    
24. Workbooks(fn).Activate
    
25. Dim Ay()
    
26. For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
    
27. For j = 2 To 14
    
28.           ReDim Preserve Ay(s)
    
29.           Ay(s) = Array(Cells(i, j).Value)
    
30.           s = s + 1
    
31. Next j
    
32. Next i
    
33. Workbooks("Main.xls").Activate
    
34. With Sheets("MRP")
    
35.     Cells(4, 14).NumberFormat = "dd/mm/yyyy"
    
36.     Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Resize(s, 13) = Application.Transpose(Application.Transpose(Ay))
    
37. End With
    
38. End sub

複製代碼

Hsieh

aw.Sheets("sheet1").[B11:N22].Copy Workbooks("Main").Sheets("MRP").[B11:N22]

jesscc

以下代碼，想做的動作是:
按"確定"會刪除Range("B7:J1000")的資料，按下"取消"就退出程式，不做動作。
可是不管我按哪一個都沒有作用，是哪裡有錯嗎?

1. Sub Macro1()
   
2. MsgBox "這樣做會清除 NEW 工作頁的資料!" & vbCrLf & vbCrLf & "你確定要這樣做嗎?", vbOKCancel + vbQuestion, "清除 NEW 原始資料!"
   
3. If Var = 1 Then
   
4. Worksheets("NEW").Range("B7:J1000").ClearContents
   
5. End If
   
6. If Var = 2 Then
   
7. Exit Sub
   
8. End If
   
9. End Sub

複製代碼