VBA SendKeys到另一个窗口不起作用

Question

我有以下宏，旨在快速切换两个 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 移动到下一页。

Answer 1

试试这个方法。测试和工作。您可以更改等待数字以延长延迟时间。确保 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