麻辣家族討論版版 - Powered by Discuz! Board

標題: [發問] 卡住了--自動化執行 [打印本頁]

作者: ui123 時間: 2014-6-8 21:30 標題: 卡住了--自動化執行

各位大大，這幾天遇到一個程式無法接下去跑的問題，試了3,4天還是無法接下去跑(如附件[attach]18454[/attach]，謝謝*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 時間: 2014-6-9 08:45

回復 1# ui123
請修改一下

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

複製代碼

Option Explicit
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.xls").Sheets(1).Range("A:A").Value = .Range("A:A").Value
End With
Application.Run "Open.xlsm!P1e" '執行其他活頁簿的程序
'這程序中執行其他活頁簿的程序P1e,程序P1e中程式碼關閉 "這活頁簿",等於停止VBA程式的執行,不會再繼續下去P1e的程式碼
'建議不要執行這 Application.Run
End Sub

複製代碼

作者: ui123 時間: 2014-6-9 10:43

回復 2# GBKEE

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

作者: GBKEE 時間: 2014-6-9 14:42

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

Option Explicit
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.xls").Sheets(1).Range("A:A").Value = .Range("A:A").Value
End WithEnd Sub

複製代碼

作者: ui123 時間: 2014-6-10 13:24

回復 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 時間: 2014-6-10 15:12

回復 5# ui123

Sub openworksheet()

複製代碼

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

作者: ui123 時間: 2014-6-12 10:46

回復 6# GBKEE

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

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

歡迎光臨麻辣家族討論版版 (http://forum.twbts.com/)