主项目中子项目Task的Text12字段变更无法触发行着色解决问询

• 主项目中，修改任务Text12字段为“OK”“NOK”等值时，VBA会为对应任务行设置特定颜色，主项目任务正常生效
• 子项目任务修改Text12字段时，仅触发App_ProjectBeforeTaskChange事件，未触发Proj_Change事件，导致着色功能失效
• 尝试直接在App_ProjectBeforeTaskChange调用ApplyColor、使用定时器、延迟执行SelectRow均失败，报错“此方法在当前场景不可用”

原因分析 #

子项目属于嵌入对象，修改子项目任务时主项目的Proj_Change事件不会被触发；且App_ProjectBeforeTaskChange事件触发期间，Project处于任务变更的锁定状态，无法直接执行SelectRow和Font32Ex这类界面操作方法。

解决方案 #

通过Application.OnTime延迟执行着色操作，避开事件触发时的锁定状态；同时针对子项目任务，先激活子项目所在窗口，再执行行选择和着色操作，最后切回原主项目视图保证操作连贯性。

修改后的代码 #

ThisProject模块

Private Sub Project_Open(ByVal pj As Project)
    InitializeEventHandler
End Sub

Module1（标准模块）

Option Explicit
Dim EventHandler As EventClassModule

Sub InitializeEventHandler()
    Set EventHandler = New EventClassModule
    Set EventHandler.App = Application
End Sub

Sub ApplyColor()
    Dim t As Task
    Dim subProj As Subproject
    Dim originalView As View
    
    Set t = EventHandler.ChangedTask
    If t Is Nothing Then Exit Sub
    
    ' 记录当前视图，避免切换后影响用户操作
    Set originalView = ActiveProject.CurrentView
    
    ' 判断是否为子项目任务
    If t.Parent Is ActiveProject Then
        ' 主项目任务直接处理
        SelectRow Row:=t.UniqueID, RowRelative:=False
    Else
        ' 找到对应子项目并激活其窗口
        For Each subProj In ActiveProject.Subprojects
            If subProj.Project Is t.Parent Then
                subProj.Activate
                SelectRow Row:=t.UniqueID, RowRelative:=False
                Exit For
            End If
        Next subProj
    End If
    
    ' 执行着色
    Select Case EventHandler.NewValue
        Case "OK"
            Font32Ex CellColor:=14282722 ' 绿色
        Case "NOK"
            Font32Ex CellColor:=11324407 ' 红色
        Case "PROGRESS"
            Font32Ex CellColor:=65535 ' 蓝色
        Case "REPEAT"
            Font32Ex CellColor:=15652797 ' 黄色
        Case Else
            Font32Ex CellColor:=-16777216 ' 无颜色
    End Select
    
    ' 切回原主项目视图
    originalView.Apply
End Sub

EventClassModule（类模块）

Public WithEvents App As Application

Public NewValue As String
Public ChangedTask As Task

Private Sub App_ProjectBeforeTaskChange(ByVal tsk As Task, ByVal Field As PjField, ByVal NewVal As Variant, Cancel As Boolean)
    If Field = pjCustomTaskText12 Then ' 用枚举常量替代硬编码，提升可读性与兼容性
        Set ChangedTask = tsk
        NewValue = NewVal
        ' 延迟0.1秒执行着色，避开事件锁定状态
        Application.OnTime Now + TimeValue("00:00:00.1"), "ApplyColor"
    End If
End Sub

注意事项 #

1. 用枚举常量pjCustomTaskText12替代硬编码字段ID，避免版本或环境差异导致的错误
2. 延迟时间可根据实际情况微调（0.1秒足够避开锁定）
3. 确保所有子项目已正确嵌入主项目，未处于只读状态

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