Excel快捷键截图需求：捕获带任务栏的当前聚焦显示器

核心思路 #

要实现需求，关键是精准获取当前活动窗口所在显示器的完整显示区域（包含任务栏），而非主屏幕或单个窗口。可以通过Windows API获取目标显示器的边界信息，再基于该区域完成截图，同时搭配全局热键实现Excel外触发。

一、修改Zack Barresse代码的关键步骤 #

Zack的代码核心问题是固定使用主屏幕区域，只需替换为当前活动窗口所在显示器的区域即可。以下是具体修改逻辑：

• 获取当前活动窗口句柄：用GetForegroundWindowAPI获取当前聚焦的窗口句柄，以此定位其所在显示器。
• 获取目标显示器的完整区域：通过MonitorFromWindow根据窗口句柄获取对应显示器句柄，再用GetMonitorInfo获取该显示器的完整矩形区域（rcMonitor字段，包含任务栏）。
• 替换截图区域：将原代码中主屏幕的区域参数，替换为上述获取的当前显示器区域，即可实现仅捕获目标显示器的完整桌面。

二、完整实现代码（VBA） #

Option Explicit

' Windows API声明
Private Declare PtrSafe Function GetForegroundWindow Lib "user32" () As LongPtr
Private Declare PtrSafe Function MonitorFromWindow Lib "user32" (ByVal hwnd As LongPtr, ByVal dwFlags As Long) As LongPtr
Private Declare PtrSafe Function GetMonitorInfoA Lib "user32" (ByVal hMonitor As LongPtr, lpmi As MONITORINFO) As Boolean
Private Declare PtrSafe Function RegisterHotKey Lib "user32" (ByVal hwnd As LongPtr, ByVal id As Long, ByVal fsModifiers As Long, ByVal vk As Long) As Boolean
Private Declare PtrSafe Function UnregisterHotKey Lib "user32" (ByVal hwnd As LongPtr, ByVal id As Long) As Boolean
Private Declare PtrSafe Function BitBlt Lib "gdi32" (ByVal hDestDC As LongPtr, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As LongPtr, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare PtrSafe Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As LongPtr) As LongPtr
Private Declare PtrSafe Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As LongPtr, ByVal nWidth As Long, ByVal nHeight As Long) As LongPtr
Private Declare PtrSafe Function SelectObject Lib "gdi32" (ByVal hdc As LongPtr, ByVal hObject As LongPtr) As LongPtr
Private Declare PtrSafe Function DeleteDC Lib "gdi32" (ByVal hdc As LongPtr) As Long
Private Declare PtrSafe Function DeleteObject Lib "gdi32" (ByVal hObject As LongPtr) As Long
Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
Private Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hwnd As LongPtr, ByVal hdc As LongPtr) As Long

' 常量定义
Private Const MONITOR_DEFAULTTONEAREST = &H2
Private Const MOD_ALT = &H1
Private Const VK_1 = &H31
Private Const SRCCOPY = &HCC0020

' 显示器信息结构体
Private Type MONITORINFO
    cbSize As Long
    rcMonitor As RECT
    rcWork As RECT
    dwFlags As Long
End Type

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

Private Sub Workbook_Open()
    ' 注册全局热键Alt+1
    RegisterHotKey Application.hwnd, 1, MOD_ALT, VK_1
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    ' 取消热键注册
    UnregisterHotKey Application.hwnd, 1
End Sub

Private Sub CaptureCurrentMonitor()
    Dim hwndForeground As LongPtr
    Dim hMonitor As LongPtr
    Dim mi As MONITORINFO
    Dim hDCDesktop As LongPtr
    Dim hDCMemory As LongPtr
    Dim hBitmap As LongPtr
    Dim hOldBitmap As LongPtr
    Dim ws As Worksheet
    
    ' 获取当前活动窗口
    hwndForeground = GetForegroundWindow()
    If hwndForeground = 0 Then Exit Sub
    
    ' 获取窗口所在显示器
    hMonitor = MonitorFromWindow(hwndForeground, MONITOR_DEFAULTTONEAREST)
    If hMonitor = 0 Then Exit Sub
    
    ' 获取显示器完整区域（含任务栏）
    mi.cbSize = Len(mi)
    If Not GetMonitorInfoA(hMonitor, mi) Then Exit Sub
    
    ' 初始化DC和位图
    hDCDesktop = GetDC(0)
    hDCMemory = CreateCompatibleDC(hDCDesktop)
    hBitmap = CreateCompatibleBitmap(hDCDesktop, mi.rcMonitor.Right - mi.rcMonitor.Left, mi.rcMonitor.Bottom - mi.rcMonitor.Top)
    hOldBitmap = SelectObject(hDCMemory, hBitmap)
    
    ' 截取目标显示器区域
    BitBlt hDCMemory, 0, 0, mi.rcMonitor.Right - mi.rcMonitor.Left, mi.rcMonitor.Bottom - mi.rcMonitor.Top, hDCDesktop, mi.rcMonitor.Left, mi.rcMonitor.Top, SRCCOPY
    
    ' 恢复DC对象
    SelectObject(hDCMemory, hOldBitmap)
    DeleteDC hDCMemory
    ReleaseDC 0, hDCDesktop
    
    ' 将截图粘贴到Excel工作表
    Set ws = ThisWorkbook.ActiveSheet
    ws.PasteSpecial Format:="Bitmap", Link:=False, DisplayAsIcon:=False
    DeleteObject hBitmap
End Sub

' 注：VBA原生消息循环限制，需通过子类化或第三方工具实现热键触发的消息监听
' 可借助Application.OnTime定期检查热键状态，或使用专门的VBA消息监听类

三、关键说明 #

1. 全局热键实现：代码中通过RegisterHotKey注册Alt+1热键，但VBA原生消息循环限制，需结合子类化或第三方工具实现完整的热键触发监听（示例中仅给出核心截图逻辑）。
2. 区域准确性：rcMonitor字段包含显示器的完整物理区域，而非仅工作区（rcWork不含任务栏），确保截图包含任务栏。
3. 兼容性：代码使用PtrSafe声明，支持64位Excel，若需兼容32位可移除PtrSafe并调整指针类型。

四、简化替代方案 #

若不想复杂修改代码，可借助Windows自带工具快速实现：

• 创建批处理文件执行start ms-screenclip:（Windows 10+），触发当前显示器截图
• 通过AutoHotkey将Alt+1映射到该批处理，并添加自动粘贴到Excel的逻辑

该方案依赖系统工具，自定义程度较低，适合快速落地。

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