WindowUtils.bas #2

Attribute VB_Name = "WindowUtils"
Option Explicit

Private Declare Function GetForegroundWindow Lib "user32" () As Long
Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Private Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
Private Declare Function BringWindowToTop Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function AttachThreadInput Lib "user32.dll" (ByVal idAttach As Long, ByVal idAttachTo As Long, ByVal fAttach As Long) As Long
Private Declare Function SetFocusAPI Lib "user32.dll" Alias "SetFocus" (ByVal hwnd As Long) As Long
Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" _
                    (ByVal uAction As Long, ByVal uParam As Long, ByRef lpvParam As Any, ByVal fuWinIni As Long) As Long
Private Declare Function LockSetForegroundWindow Lib "user32" (ByVal uLockCode As Long) As Boolean
Private Declare Function AllowSetForegroundWindow Lib "user32" (ByVal dwProcessId As Long) As Boolean
Private Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function SetActiveWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Boolean

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
        (ByVal lpClassName As String, ByVal lpWindowName As Long) As Long
   
Private Const SPI_GETFOREGROUNDLOCKTIMEOUT As Long = &H2000
Private Const SPI_SETFOREGROUNDLOCKTIMEOUT As Long = &H2001
Private Const ASFW_ANY As Long = -1
Private Const LSFW_LOCK As Long = 1
Private Const LSFW_UNLOCK As Long = 2
Private Const SW_RESTORE As Long = 9

Public Sub ActivateDocumentWindow(hwnd As Long)

    Dim currentThread As Long, activeWindow As Long, activeProcess As Long, windowProcess As Long
    Dim activeThread As Long, windowThread As Long
    
    currentThread = GetCurrentThreadId
    activeWindow = GetForegroundWindow
    activeThread = GetWindowThreadProcessId(activeWindow, activeProcess)
    windowThread = GetWindowThreadProcessId(hwnd, windowProcess)
    
    If currentThread <> activeThread Then
        AttachThreadInput currentThread, activeThread, True
    End If
    If windowThread <> currentThread Then
        AttachThreadInput windowThread, currentThread, True
    End If
    
    Dim oldTimeout As Long, newTimeout As Long, lResult As Long
    lResult = SystemParametersInfo(SPI_GETFOREGROUNDLOCKTIMEOUT, 0&, oldTimeout, 0)
    lResult = SystemParametersInfo(SPI_SETFOREGROUNDLOCKTIMEOUT, 0&, newTimeout, 0)
    LockSetForegroundWindow LSFW_UNLOCK
    AllowSetForegroundWindow ASFW_ANY
    
    SetForegroundWindow hwnd
    SetActiveWindow hwnd
    BringWindowToTop hwnd
    ShowWindow hwnd, SW_RESTORE

    lResult = SystemParametersInfo(SPI_SETFOREGROUNDLOCKTIMEOUT, 0&, oldTimeout, 0)
    If currentThread <> activeThread Then
        AttachThreadInput currentThread, activeThread, False
    End If
    If windowThread <> currentThread Then
        AttachThreadInput windowThread, currentThread, False
    End If
    
End Sub

Public Function GetPowerpointWindowHandle() As Long
    ' Replace the frame_class place holder with one of the following:
    ' PPTFrameClass for PowerPoint 2010/13
    ' PP12FrameClass for PowerPoint 2007
    ' PP11FrameClass for PowerPoint 2003
    ' PP10FrameClass for PowerPoint 2002
    ' PP9FrameClass for PowerPoint 2000
    ' PP97FrameClass for PowerPoint 97
    GetPowerpointWindowHandle = FindWindow("PPTFrameClass", 0&)
End Function