VBA SendKeys в другое окно не работает - PullRequest
Новая
       7

VBA SendKeys в другое окно не работает

0 голосов
/ 02 мая 2018

У меня есть следующий макрос, который предназначен для быстрого переключения двух PDF-файлов. После 8 быстрых переключений макрос должен перейти на следующие страницы обоих PDF-файлов и повторить процедуру. К сожалению, макрос-свитки сначала объявляли только PDF Есть идеи как это исправить? 

Private Declare PtrSafe Function BringWindowToTop Lib "user32" (ByVal lngHWnd As LongPtr) As LongPtr

Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr

Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMiliseconds As Long)


Sub switching_pdfs()

Dim i As Integer, j As Integer

ptr1 = FindWindow(vbNullString, "Some PDF 1.pdf - Acrobat Reader")
ptr2 = FindWindow(vbNullString, "Some PDF 2.pdf - Acrobat Reader")

For i = 1 To 30
    For j = 1 To 4
       BringWindowToTop (ptr1)
       Sleep 100
       BringWindowToTop (ptr2)
       Sleep 100
    Next j
BringWindowToTop (ptr1)
Application.SendKeys "{RIGHT}": Sleep 500: DoEvents 'should move to the next page in the first PDF
BringWindowToTop (ptr2)
Application.SendKeys "{RIGHT}": Sleep 500: DoEvents 'should move to the next page in the second PDF
Next i
End Sub

Я также пытался использовать SendMessage, но он не хочет перемещать PDF на следующую страницу.

1 Ответ

0 голосов
/ 02 мая 2018

Попробуйте этот подход. Проверено и работает. Вы можете изменить числа ожидания, чтобы увеличить задержку. Убедитесь, что файлы PDF названы правильно, и в имени файла нет лишних пробелов. 

Sub switching_pdfs()
    Dim i As Integer, j As Integer
    Dim ptr1 As String, ptr2 As String
    ptr1 = "Some PDF 1.pdf - Acrobat Reader"
    ptr2 = "Some PDF 2.pdf - Acrobat Reader"

    For i = 1 To 30
        For j = 1 To 4
           AppActivate ptr1
           Wait 0.5
           AppActivate ptr2
           Wait 0.5
        Next j
        AppActivate ptr1
        Send "{RIGHT}"
        Wait 1
        AppActivate ptr2
        Send "{RIGHT}"
        Wait 1
    Next i
End Sub
Function Send(pData As String)
    SendKeys pData, True
    Wait 0.5
End Function
Function Wait(Optional pWaitTime As Single = 0.1)
    Dim StartTime
    StartTime = Timer
    Do While (Timer < StartTime + pWaitTime)
        DoEvents
    Loop
End Function
...