[英]Looping with Application.ontime
I am trying to loop the function below. 我试图循环下面的功能。 The goal is to copy and paste from PDF files onto separate worksheets.
目的是将PDF文件复制并粘贴到单独的工作表上。 The basic copy and paste function works, however, when I try to loop it executes each Private Sub 3 times before moving onto the next Private Sub.
基本的复制和粘贴功能有效,但是,当我尝试循环时,它将执行每个Private Sub 3次,然后再移至下一个Private Sub。 For example, before Private Sub SecondStep tries to copy and paste from the same PDF three times in a row.
例如,在Private Sub SecondStep尝试连续三次从同一PDF复制和粘贴之前。
Can anyone help on how to loop this correctly? 谁能帮助您正确循环?
Sub PDF_Copy_Paste_Loop()
Dim AdobeApp As String
Dim AdobeFile As String
Dim StartAdobe
Dim myfile As String
Dim i As Integer
i = 1
Do While i < 4
AppActivate "Tests - Excel"
Workbooks("tests").Sheets("Sheet1").Activate
myfile = Cells(i, 1)
AdobeApp = "C:\Program Files (x86)\Adobe\Acrobat 10.0\Acrobat\Acrobat.exe"
AdobeFile = "C:\Users\klanders\Desktop\" & myfile & ".pdf"
StartAdobe = Shell("" & AdobeApp & " " & AdobeFile & "", 1)
Application.OnTime Now + TimeValue("00:00:02"), "FirstStep2"
i = i + 1
Loop
End Sub
Private Sub FirstStep()
SendKeys ("^a")
SendKeys ("^c")
Application.OnTime Now + TimeValue("00:00:04"), "SecondStep2"
End Sub
Private Sub SecondStep()
AppActivate "Book1 - Excel"
Workbooks("Book1").Sheets("Sheet" & i).Activate
Range("A1").Select
SendKeys ("^v")
Application.OnTime Now + TimeValue("00:00:06"), "ThirdStep2"
End Sub
Private Sub ThirdStep()
Sheets.Add
End Sub
Maybe this will help (not tested) 也许这会有所帮助(未经测试)
Option Explicit
Sub PDF_Copy_Paste_Loop()
Dim AdobeApp As String, AdobeFile As String
Dim i As Long, ws As Worksheet, wb As Workbook
'out of the loop (static value)
AdobeApp = "C:\Program Files (x86)\Adobe\Acrobat 10.0\Acrobat\Acrobat.exe"
Set wb = Workbooks("Book1")
Set ws = Workbooks("tests").Worksheets("Sheet1")
i = 1
Do While i < 4
AdobeFile = "C:\Users\klanders\Desktop\" & ws.Cells(i, 1).Value2 & ".pdf"
Shell AdobeApp & " " & AdobeFile, 1
Application.Wait Now + TimeValue("0:00:02") 'pause 2 seconds
SendKeys "^a"
SendKeys "^c"
Application.Wait Now + TimeValue("0:00:02")
AppActivate "Book1 - Excel"
wb.Worksheets(i).Range("A1").Select
SendKeys "^v"
Application.Wait Now + TimeValue("0:00:02")
wb.Worksheets.Add
i = i + 1
Loop
End Sub
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.