如何捕获通过调整列宽触发的嵌入式图表resize事件？

方案1：工作表级列宽监控（基于SelectionChange事件） #

调整列宽本身不会触发Chart Resize事件，但会间接触发Worksheet_SelectionChange（即使未切换选区，调整列宽后列标保留焦点也会触发）。通过缓存目标列初始宽度，对比当前宽度判断是否调整，进而执行图表相关逻辑。

1. 在目标工作表代码模块声明私有变量缓存列宽：

Private prevBEColumnWidth As Double

2. 工作表激活时初始化缓存值：

Private Sub Worksheet_Activate()
    prevBEColumnWidth = Me.Columns("BE").ColumnWidth
End Sub

3. 监控列宽变化并执行逻辑：

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim currentWidth As Double
    currentWidth = Me.Columns("BE").ColumnWidth
    
    ' 用微小阈值避免浮点误差误触发
    If Abs(currentWidth - prevBEColumnWidth) > 0.001 Then
        HandleChartResize
        prevBEColumnWidth = currentWidth
    End If
End Sub

Private Sub HandleChartResize()
    ' 替换为图表调整后的处理逻辑
    With Me.ChartObjects("图表 1").Chart
        ' 示例：调整标题位置、数据标签等操作
    End With
    With Me.ChartObjects("图表 2").Chart
        ' 示例：调整标题位置、数据标签等操作
    End With
End Sub

方案2：应用级列宽监控（覆盖全工作簿选区变化） #

如果工作表级SelectionChange不够可靠（比如用户调整列宽后未点击任何区域），可通过应用级事件监控所有工作表的选区变化，针对性处理目标工作表的列宽调整。

1. 新建类模块，命名为AppEvents，写入代码：

Public WithEvents app As Application
Private prevBEColumnWidth As Double
Private targetSheet As Worksheet

Private Sub Class_Initialize()
    ' 替换为你的目标工作表名称
    Set targetSheet = ThisWorkbook.Sheets("Sheet1")
    prevBEColumnWidth = targetSheet.Columns("BE").ColumnWidth
End Sub

Private Sub app_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    If Sh Is targetSheet Then
        Dim currentWidth As Double
        currentWidth = targetSheet.Columns("BE").ColumnWidth
        
        If Abs(currentWidth - prevBEColumnWidth) > 0.001 Then
            HandleChartResize targetSheet
            prevBEColumnWidth = currentWidth
        End If
    End If
End Sub

Private Sub HandleChartResize(ByVal ws As Worksheet)
    ' 这里写图表调整后的处理逻辑
    MsgBox "图表已随列宽调整大小"
End Sub

2. 在ThisWorkbook模块初始化应用事件：

Private appEvt As AppEvents

Private Sub Workbook_Open()
    Set appEvt = New AppEvents
    Set appEvt.app = Application
End Sub

方案3：Windows API实时监控列宽调整消息（进阶） #

如果需要完全实时捕获列宽调整动作（不依赖选区或计算事件），可通过Windows API拦截Excel窗口消息，直接监听列宽变化通知。

32位Excel版本代码（标准模块）： #

Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Const GWL_WNDPROC = -4
Const WM_NOTIFY = &H4E
Const HDN_ITEMCHANGED = &HFFFFFD11

Dim prevWndProc As Long
Dim xlHwnd As Long

Sub HookExcelWindow()
    xlHwnd = FindWindow("XLMAIN", Application.Caption)
    prevWndProc = SetWindowLong(xlHwnd, GWL_WNDPROC, AddressOf WndProc)
End Sub

Sub UnhookExcelWindow()
    SetWindowLong xlHwnd, GWL_WNDPROC, prevWndProc
End Sub

Function WndProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    If Msg = WM_NOTIFY Then
        Dim pNMhdr As NMHDR
        CopyMemory pNMhdr, ByVal lParam, Len(pNMhdr)
        If pNMhdr.code = HDN_ITEMCHANGED Then
            ' 检查当前工作表是否为目标表
            If ActiveSheet.Name = "Sheet1" Then
                HandleChartResize ActiveSheet
            End If
        End If
    End If
    WndProc = CallWindowProc(prevWndProc, hwnd, Msg, wParam, lParam)
End Function

Private Type NMHDR
    hwndFrom As Long
    idFrom As Long
    code As Long
End Type

64位Excel版本代码（标准模块）： #

Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
Declare PtrSafe Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As LongPtr, ByVal hwnd As LongPtr, ByVal Msg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)

Const GWL_WNDPROC = -4
Const WM_NOTIFY = &H4E
Const HDN_ITEMCHANGED = &HFFFFFD11

Dim prevWndProc As LongPtr
Dim xlHwnd As LongPtr

Sub HookExcelWindow()
    xlHwnd = FindWindow("XLMAIN", Application.Caption)
    prevWndProc = SetWindowLong(xlHwnd, GWL_WNDPROC, AddressOf WndProc)
End Sub

Sub UnhookExcelWindow()
    SetWindowLong xlHwnd, GWL_WNDPROC, prevWndProc
End Sub

Function WndProc(ByVal hwnd As LongPtr, ByVal Msg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
    If Msg = WM_NOTIFY Then
        Dim pNMhdr As NMHDR
        CopyMemory pNMhdr, ByVal lParam, Len(pNMhdr)
        If pNMhdr.code = HDN_ITEMCHANGED Then
            If ActiveSheet.Name = "Sheet1" Then
                HandleChartResize ActiveSheet
            End If
        End If
    End If
    WndProc = CallWindowProc(prevWndProc, hwnd, Msg, wParam, lParam)
End Function

Private Type NMHDR
    hwndFrom As LongPtr
    idFrom As LongPtr
    code As Long
End Type

初始化与清理（ThisWorkbook模块）： #

Private Sub Workbook_Open()
    HookExcelWindow
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    UnhookExcelWindow
End Sub

Private Sub HandleChartResize(ByVal ws As Worksheet)
    ' 执行图表调整后的逻辑
End Sub

内容的提问来源于stack exchange，提问作者RobertL-CH