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