[發問] 卡住了--自動化執行

ui123

各位大大，這幾天遇到一個程式無法接下去跑的問題，試了3,4天還是無法接下去跑(如附件 自動化執行.rar (37.22 KB)

下載次數: 10

2014-6-8 21:27

，謝謝*10~)PS:路徑設在D槽

目前有兩個問題(粗體字表示):

打開Open 活頁簿-->自動就打開了P1活頁簿-->執行P1巨集-->執行完Copy回Open活頁簿-->關閉P1活頁簿-->自動就打開了P2活頁簿-->執行P2巨集-->執行完Copy回Open活頁簿-->關閉P2活頁簿-->回到Open 活頁簿並顯示MsgBox "P1& P2 跑完 "

1) 開啟Open 自動執行" openworksheet"
2)開啟P1自動執行巨集"P1"   問題1:"關完P1 活頁簿後，沒執行下面那一行程式"，問題2: 目前Copy 無法貼到 Open 資料夾，
3)因為上面那個沒執行，所以這程式就沒接下去跑了

VBA 程式對照如下:
-------------------------
1)
Sub openworksheet()

Workbooks.Open Filename:="D:\自動化執行\P1.xlsm"

End Sub

Sub P1e()

Workbooks("Open").Activate
Workbooks("P1").Close False

'問題1: 關完P1 活頁簿後，沒執行下面那一行
Workbooks.Open Filename:="D:\自動化執行\P2.xlsm"

End Sub

Sub P2e()

Workbooks("Open").Activate
Workbooks("P2").Close False

MsgBox "P1& P2 跑完 "

End Sub
-------------------------------------------
2)
Sub P1()

Dim i As Integer

For i = 1 To 5
    Cells(i, 1).Value = Format(Now, "ss")
    Application.Wait (Now + TimeValue("00:00:01"))
Next i


Range("A:A").Copy

   
'問題2:無法貼到 Open
Windows("Open.xlsm").Activate
    Columns("A:A").Select
    ActiveSheet.Paste
    Range("A1").Select

Application.Run "Open.xlsm!P1e"

End Sub

-------------------------------------------
3)
Sub P2()

Dim i As Integer

For i = 1 To 5
    Cells(i, 1).Value = Format(Now, "ss")
    Application.Wait (Now + TimeValue("00:00:01"))
Next i


Range("A:A").Copy

    Windows("Open.xlsm").Activate
    Columns("B:B").Select
    ActiveSheet.Paste
    Range("A1").Select

Application.Run "Open.xlsm!P2e"

End Sub

GBKEE

回復 1# ui123
請修改一下

1. Option Explicit
   
2. Sub openworksheet()
   
3.     Dim AR(), E As Variant
   
4.     AR = Array("p1", "p2")
   
5.     For Each E In AR
   
6.         Workbooks.Open Filename:="D:\自動化執行\" & E & ".xls"
   
7.         ActiveWorkbook.Close False
   
8.     Next
   
9.     MsgBox Join(AR, ",") & " 跑完"
   
10. End Sub

複製代碼

1. Option Explicit
   
2. Sub P1()
   
3.     Dim i As Integer
   
4.     With ThisWorkbook.Sheets(1)
   
5.         For i = 1 To 5
   
6.             .Cells(i, 1).Value = Format(Now, "ss")
   
7.             Application.Wait (Now + TimeValue("00:00:01"))
   
8.         Next i
   
9.         Workbooks("Open.xls").Sheets(1).Range("A:A").Value = .Range("A:A").Value
   
10.     End With
    
11.     Application.Run "Open.xlsm!P1e" '執行其他活頁簿的程序
    
12.     '這程序中執行其他活頁簿的程序P1e,程序P1e中程式碼關閉 "這活頁簿",等於停止VBA程式的執行,不會再繼續下去P1e的程式碼
    
13.     '建議不要執行這  Application.Run
    
14. End Sub

複製代碼

ui123

回復 2# GBKEE

剛剛程式碼貼上去還是會卡在P1結束，沒有跑P2 ，應該是版大建議不要執行這  Application.Run
小的不才，程式跟程式間不知如何銜接，所以無法自動執行下去，有其它方式可以使用嗎? 感謝您~

GBKEE

回復 3# ui123
P1,P2的程式碼 ,有改嗎?

1. Option Explicit
   
2. Sub P1()  
   
3.     Dim i As Integer
   
4.     With ThisWorkbook.Sheets(1)
   
5.         For i = 1 To 5
   
6.             .Cells(i, 1).Value = Format(Now, "ss")
   
7.             Application.Wait (Now + TimeValue("00:00:01"))
   
8.         Next i
   
9.         Workbooks("Open.xls").Sheets(1).Range("A:A").Value = .Range("A:A").Value
   
10.     End WithEnd Sub

複製代碼

ui123

回復 4# GBKEE

感謝版大，目前程式碼如下，P1我想接下去P2 ，但失敗

Sub P1()
    Dim i As Integer
    With ThisWorkbook.Sheets(1)
        For i = 1 To 5
            .Cells(i, 1).Value = Format(Now, "ss")
            Application.Wait (Now + TimeValue("00:00:01"))
        Next i
        Workbooks("Open.xlsm").Sheets(1).Range("A:A").Value = .Range("A:A").Value
    End With
    Application.Run "Open.xlsm!P1e" '<----有跳到下面的P1e 執行，但是Workbooks.Open Filename:="D:\自動化執行\P2.xlsm"<----沒跑這個

End Sub

Sub P1e()

Workbooks("Open").Activate
Workbooks("P1").Close False '目前測試不想儲存<----有關起來

Workbooks.Open Filename:="D:\自動化執行\P2.xlsm"<----"""沒跑這個，就是這一個地方皆不下去"""

End Sub

GBKEE

回復 5# ui123

1. Sub openworksheet()

複製代碼

有修改成2#的Sub openworksheet()嗎?
P1(),P2()的程式碼 ,有修改成2#的P1,P2嗎?

ui123

回復 6# GBKEE

Ya~~~成功了GBKEE 大，我看懂了，可以自動化了

不要執行這  Application.Run ---> is the key,I got it !!!<(_ _)> 很開心