如何解决Excel VBA重新开启ScreenUpdating时屏幕闪烁的问题

根因分析 #

连续触发主题切换宏时，Excel图形渲染线程和VBA执行线程异步运行，即使关闭了屏幕更新，未完成的渲染队列也可能在属性修改过程中被提前刷新到界面，导致出现逐个切换的可见过程；重复触发也会导致多段修改逻辑叠加执行，放大渲染可见性。

优化方案 #

1. 补充全局性能配置禁用 #

除已有配置外，临时关闭计算、状态栏等额外性能损耗项，同时新增执行状态锁拦截重复触发，避免逻辑叠加：

' 模块顶部声明状态锁变量
Public isThemeSwitching As Boolean

Sub EnableDarkTheme()
    ' 重复触发直接拦截
    If isThemeSwitching Then Exit Sub
    isThemeSwitching = True
    
    ' 保存原有配置，执行完成后恢复
    Dim oriCalc As XlCalculation: oriCalc = Application.Calculation
    Dim oriStatusBar As Boolean: oriStatusBar = Application.DisplayStatusBar
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    Application.DisplayStatusBar = False
    
    ' 原有业务逻辑
    MenuOptions.Range("B11").Value = "On"
    Call EnableDarkThemeBasicInAllSheets
    Call EnableDarkThemeInFrontpage
    Call EnableDarkThemeInDashboard
    Call EnableDarkThemeInWegdiagramme
    Call EnableDarkThemeInAliasstruktur
    Call SetDarkThemeSettings("On", MenuOptions.Range("B2").Value)
    
    ' 等待10毫秒让所有属性修改缓存完成，再一次性刷新
    Application.Wait Now + TimeValue("00:00:00") / 100
    
    ' 恢复原有配置
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.Calculation = oriCalc
    Application.DisplayStatusBar = oriStatusBar
    
    isThemeSwitching = False
End Sub

同时可以在所有子过程入口增加一行Application.ScreenUpdating = False，避免子过程意外触发刷新。

2. 优化Shape操作逻辑 #

• 合并同属性Shape的修改：把同一工作表下需要设置相同填充色、字体色的Shape放到同一个Shapes.Range数组中，一次性批量修改属性，不要逐个Shape单独处理，大幅减少对象解析次数
• 禁止在子过程中使用Activate/Select等激活操作，所有对象直接通过工作表变量引用，避免触发不必要的界面重绘
• 修正代码错误：现有代码中的RGB(256, 256, 256)为非法写法，RGB取值范围为0~255，修改为RGB(255,255,255)，避免Excel额外的数值转换损耗

3. 子过程优化示例 #

With Frontpage
    ' 批量修改所有同填充规则的Shape
    With .Shapes.Range(Array("Background_Basic_Functions", "其他需要同填充的Shape名称"))
        .Fill.ForeColor.ObjectThemeColor = msoThemeColorText1
        .Fill.ForeColor.Brightness = 0.25
    End With
    ' 批量修改所有同字体规则的Shape
    Dim shp As Shape
    For Each shp In .Shapes.Range(Array("Background_Basic_Functions", "其他需要同字体的Shape名称"))
        If shp.HasTextFrame Then ' 增加判断避免无文本的Shape报错
            shp.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(255, 255, 255)
        End If
    Next
End With

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