VBA
1 TopicMS Project Professional - VBA Color row based on field value
I have a master project with code below. What it does it: whenever I change the field Text12 to "OK" or "NOK" (and other words) it colors the whole row with a specific color (see Module1). It works great at a master project level, that is, in tasks directly in this master project. (How it works: It checks for changes in the Text12 column and sets a bool to true. Then, in Proj_Change, it applies the colors to the correct task row) However, it doesn't work at a Subproject level. I've added Debug.Print to each sub, and when I edit a Subproject's task, it only calls up to App_ProjectBeforeTaskChange. Is there a way to solve this? Detect changes in Subprojects and color the rows? I've tried running the ApplyColor sub directly from the App_ProjectBeforeTaskChange sub, but VBA says "this method is not available in this situation". Also tried using a Timer, didn't work, same error. (PS: I also posted this on Stack Overflow but I couldnt get help, so I'm posting this on other forums) ThisProject: Private Sub Project_Open(ByVal pj As Project) InitializeEventHandler End Sub Module1: Regular Module Option Explicit Dim EventHandler As EventClassModule Sub InitializeEventHandler() Set EventHandler = New EventClassModule Set EventHandler.App = Application Set EventHandler.proj = Application.ActiveProject End Sub Sub ApplyColor() Dim t As Task Set t = EventHandler.ChangedTask If Not t Is Nothing Then SelectRow Row:=t.UniqueID, RowRelative:=False Select Case EventHandler.NewValue Case "OK" Font32Ex CellColor:=14282722 'green Case "NOK" Font32Ex CellColor:=11324407 'red Case "PROGRESS" Font32Ex CellColor:=65535 'blue Case "REPEAT" Font32Ex CellColor:=15652797 'yellow Case Else Font32Ex CellColor:=-16777216 'no color End Select End If End Sub EventClassModule: ClassModule Public WithEvents App As Application Public WithEvents proj As Project Public NewValue As String Public ChangePending As Boolean 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 = 188743998 Then 'Custom field Text12 Set ChangedTask = tsk NewValue = NewVal ChangePending = True End If End Sub Private Sub Proj_Change(ByVal pj As Project) If ChangePending Then ApplyColor ChangePending = False End If End Sub291Views0likes0Comments