[發問] 請教一下跑迴圈如何使用其他XLS

yanto913

如題：我寫了一個簡單的VBA但是發現只要開始跑迴圈時，就不能開其他XLS檔與自己檔的其他sheets
Private Sub CommandButton1_Click()
Do While Range("B2") = 1
Range("A1") = Range("A2")
DoEvents
Loop
End Sub

請教各位先進如何在跑迴圈時還可以用其他的EXCEL檔與編輯自己其他的活頁

yanto913

謝謝et5323 ，我再試試onTime的方法...多謝！

et5323

1.你的代碼應該根本就不能運行，因為Settimer的回調函數就不是象你的Asub和Bsub那樣寫的，具體的查MSDN。
2.由於用了API,很容易就崩潰或陷入閉環的下場。
3.最好還是考慮用VBA的onTime來寫。

GBKEE

回復 10# yanto913
API 函數我不熟, 還是回到你一樓的DO  LOOP 迴圈試試看,但還是有缺點 如儲存格有在作輸入動作,程式會停止
Module的程式碼

1. Dim MyTime As Single, MyStop As Boolean
   
2. Private Const PauseTime = (1 / 60) * 2  ' " * 2 " ->  "0.2秒"
   
3. Sub StartAsub()
   
4.     MyStop = False
   
5.     MyTime = Timer + PauseTime
   
6.     Do
   
7.         If MyTime <= Timer Then
   
8.             MyTime = Timer + PauseTime
   
9.             With Workbooks("Book1.xls").Sheets("Sheet1").Range("a1")
   
10.                 .Value = .Value + 1
    
11.             End With
    
12.         End If
    
13.         DoEvents
    
14.     Loop While MyStop = False
    
15. End Sub
    
16. Sub StopAsub()
    
17.     MyStop = True
    
18. End Sub

複製代碼

yanto913

版大們，去掉 ActiveSheet.，可以開但是會發生
1.當Sheet1跳到Sheet2沒問題，Sheet2再跳到Sheet3就會錯誤了
2.當要編輯儲存格時也會發生錯誤(A1仍在計數中)

GBKEE

回復 8# yanto913
With ActiveSheet.Workbooks("book1.xls").Sheets("sheet1").Range("b1")
語法錯誤  請去掉 ActiveSheet.

yanto913

我將程式修改成如下，結果程式變成不能跑了，而且在未修改前可以跑兩個程式，但開啟其他EXCEL檔後程式會變成跑到另一個新EXCEL做運算(ex,跑到book2.xls中做計數)
Option Explicit
Declare Function SetTimer _
    Lib "user32" ( _
        ByVal hWnd As Long, _
        ByVal nIDEvent As Long, _
        ByVal uElapse As Long, _
        ByVal lpTimerFunc As Long) _
As Long
Declare Function KillTimer _
    Lib "user32" ( _
        ByVal hWnd As Long, _
        ByVal nIDEvent As Long) _
As Long
'EXCEL視窗的handle, id設為1, 每 0.2秒執行1次Asub程序
Sub StartAsub()
    SetTimer Application.hWnd, 1, 200, AddressOf Asub
End Sub
Sub StopAsub()
    KillTimer Application.hWnd, 1
End Sub
Sub StartBsub()
    SetTimer Application.hWnd, 2, 500, AddressOf Bsub
End Sub
Sub StopBsub()
    KillTimer Application.hWnd, 2
End Sub
Sub Asub()
With ActiveSheet.Workbooks("book1.xls").Sheets("sheet1").Range("a1")
    .Value = .Value + 1
End With
End Sub
Sub Bsub()
With ActiveSheet.Workbooks("book1.xls").Sheets("sheet1").Range("b1")
    .Value = .Value + 1
End With
End Sub

oobird

我試過可以的。
開本活頁簿的

下載 (33.25 KB)

2010-10-3 00:10

其他工作表或另開新檔都沒問題。

yanto913

GBKEE版大
我試過了，可是仍然不能開啟其他EXCEL檔耶！

GBKEE

回復 1# yanto913
指明是哪一個WorkBooks("xxx.xls").Sheets("xxx") 試試看
Private Sub CommandButton1_Click()
Do While WorkBooks("xxx.xls").Sheets("xxx").Range("B2") = 1
WorkBooks("xxx.xls").Sheets("xxx").Range("A1") = WorkBooks("xxx.xls").Sheets("xxx").Range("A2")
DoEvents
Loop
End Sub