Excel 365中Action Pen缩放回退及VBA代码运行问题求助

现有代码的问题分析 #

你的无限Do Loop宏会持续占用Excel主线程，即便加入DoEvents仍会导致界面响应迟缓甚至冻结，因为它始终在后台循环执行，无法有效释放资源。同时Action Pen的选中操作既不会触发单元格变更事件，也无法被宏录制器捕捉，常规事件监听方式失效。

优化解决方案 #

方案1：定时轮询替代无限循环 #

通过Application.OnTime实现定时检查缩放比例，既避免无限循环的冻结问题，又能及时纠正异常缩放：

1. 在标准模块中添加以下代码：

Sub CheckAndResetZoom()
    ' 仅在当前窗口缩放比例不等于100%时执行重置
    If ActiveWindow.Zoom <> 100 Then
        ActiveWindow.Zoom = 100
        ActiveWindow.ScrollColumn = 1
        ActiveWindow.ScrollRow = 1
    End If
    ' 设定0.1秒后再次执行本过程，实现定时轮询
    Application.OnTime Now + TimeValue("00:00:00.1"), "CheckAndResetZoom"
End Sub

Sub StopZoomCheck()
    ' 用于停止定时检查的宏
    On Error Resume Next
    Application.OnTime Now + TimeValue("00:00:00.1"), "CheckAndResetZoom", , False
End Sub

2. 启用与停止操作：

• 按Alt+F8执行CheckAndResetZoom宏，开始自动监控缩放比例。
• 需要停止时，执行StopZoomCheck宏即可。

3. 可选：工作簿自动启动设置
   在ThisWorkbook模块中添加以下代码，实现打开工作簿自动启动检查、关闭时停止检查：

Private Sub Workbook_Open()
    CheckAndResetZoom
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    StopZoomCheck
End Sub

方案2：监听对象选择事件（针对Action Pen选中形状/对象场景） #

如果Action Pen选中的是工作表中的形状或其他对象，可监听Workbook_SheetSelectionChange事件，结合选中对象类型判断重置缩放：

在ThisWorkbook模块中添加：

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    ' 检查是否选中了形状、图片等Action Pen常操作的对象
    If TypeName(Selection) = "ShapeRange" Or TypeName(Selection) = "Picture" Then
        If ActiveWindow.Zoom <> 100 Then
            ActiveWindow.Zoom = 100
            ActiveWindow.ScrollColumn = 1
            ActiveWindow.ScrollRow = 1
        End If
    End If
End Sub

注意：此方案仅针对Action Pen选中对象的场景，若选中单元格区域则不触发，需结合实际场景测试。

关键说明 #

• 定时轮询方案兼容性更强，无论Action Pen触发哪种类型的选中操作，都能及时纠正缩放比例，且不会导致Excel冻结。
• 使用Application.OnTime时，务必在关闭工作簿前执行StopZoomCheck，避免Excel下次启动时自动触发宏。

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