如何优化未保存工作簿的激活VBA代码（适配多显示器）

原代码在单显示器下可正常将目标工作簿窗口最大化并最小化其他窗口，但多显示器场景下会最小化所有显示器的窗口，体验不佳。以下是改进后的方案，通过Windows API识别目标工作簿所在的显示器，仅最小化该显示器上的其他窗口（含VBE窗口）：

步骤1：声明所需的Windows API函数 #

需在模块顶部添加API声明，用于获取窗口位置和显示器信息：

#If VBA7 Then
    Private Declare PtrSafe Function GetWindowRect Lib "user32" (ByVal hwnd As LongPtr, lpRect As RECT) As Boolean
    Private Declare PtrSafe Function MonitorFromPoint Lib "user32" (ByVal x As Long, ByVal y As Long, ByVal dwFlags As Long) As LongPtr
    Private Declare PtrSafe Function GetMonitorInfo Lib "user32" Alias "GetMonitorInfoA" (ByVal hMonitor As LongPtr, lpMonitorInfo As MONITORINFO) As Boolean
    Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
#Else
    Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Boolean
    Private Declare Function MonitorFromPoint Lib "user32" (ByVal x As Long, ByVal y As Long, ByVal dwFlags As Long) As Long
    Private Declare Function GetMonitorInfo Lib "user32" Alias "GetMonitorInfoA" (ByVal hMonitor As Long, lpMonitorInfo As MONITORINFO) As Boolean
    Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
#End If

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Type MONITORINFO
    cbSize As Long
    rcMonitor As RECT
    rcWork As RECT
    dwFlags As Long
End Type

Private Const MONITOR_DEFAULTTOPRIMARY = &H1

步骤2：改进后的ActivateWorkbook过程 #

Sub ActivateWorkbook(wbResults As Workbook)
    Dim objWindow As Window
    Dim targetHwnd As LongPtr
    Dim targetRect As RECT
    Dim targetMonitor As LongPtr
    Dim monitorInfo As MONITORINFO
    Dim vbeHwnd As LongPtr
    Dim vbeRect As RECT
    Dim vbeMonitor As LongPtr
    
    ' 获取目标工作簿窗口的句柄和位置
    targetHwnd = wbResults.Windows(1).hwnd
    GetWindowRect targetHwnd, targetRect
    
    ' 获取目标窗口所在的显示器
    targetMonitor = MonitorFromPoint((targetRect.Left + targetRect.Right) \ 2, (targetRect.Top + targetRect.Bottom) \ 2, MONITOR_DEFAULTTOPRIMARY)
    
    ' 获取显示器信息
    monitorInfo.cbSize = Len(monitorInfo)
    GetMonitorInfo targetMonitor, monitorInfo
    
    ' 处理VBE窗口：如果在目标显示器上则最小化
    vbeHwnd = FindWindow("wndclass_desked_gsk", Application.VBE.MainWindow.Caption)
    If vbeHwnd <> 0 Then
        GetWindowRect vbeHwnd, vbeRect
        vbeMonitor = MonitorFromPoint((vbeRect.Left + vbeRect.Right) \ 2, (vbeRect.Top + vbeRect.Bottom) \ 2, MONITOR_DEFAULTTOPRIMARY)
        If vbeMonitor = targetMonitor Then
            Application.VBE.MainWindow.WindowState = vbext_ws_Minimize
        End If
    End If
    
    ' 遍历所有Excel窗口，仅最小化目标显示器上的非目标窗口
    For Each objWindow In Application.Windows
        If objWindow.Caption <> wbResults.Name Then
            Dim winHwnd As LongPtr
            Dim winRect As RECT
            Dim winMonitor As LongPtr
            
            winHwnd = objWindow.hwnd
            GetWindowRect winHwnd, winRect
            winMonitor = MonitorFromPoint((winRect.Left + winRect.Right) \ 2, (winRect.Top + winRect.Bottom) \ 2, MONITOR_DEFAULTTOPRIMARY)
            
            ' 如果窗口在目标显示器上，最小化它
            If winMonitor = targetMonitor Then
                objWindow.WindowState = xlMinimized
            End If
        End If
    Next objWindow
    
    ' 最大化并激活目标工作簿窗口
    With Application.Windows(wbResults.Name)
        .WindowState = xlMaximized
        .Activate
    End With
End Sub

代码说明 #

• API函数作用：GetWindowRect获取窗口的屏幕坐标，MonitorFromPoint通过窗口中心点判断所属显示器，GetMonitorInfo获取显示器的工作区域，FindWindow定位VBE窗口句柄。
• 核心逻辑：先确定目标工作簿所在的显示器，再遍历所有Excel窗口和VBE窗口，仅最小化位于该显示器上的非目标窗口，最后最大化激活目标窗口。
• 兼容性：同时支持32位和64位Office（通过#If VBA7 Then分支处理指针类型）。

调用示例保持不变：

Sub ExampleCode()
    Dim wbXXX As Workbook
    
    Set wbXXX = Workbooks.Add
    
    With wbXXX
        ' 报表生成代码
    End With
    
    Call ActivateWorkbook(wbXXX)
    
    Set wbXXX = Nothing
End Sub

内容的提问来源于stack exchange，提问作者Andrew