简体   繁体   中英

MS (Project) Find Strings in text10 and change font color

I'm changing the color of font in MS Project based on Percentage complete and Names in text10 column. The percentages work however can someone give me a steer on the names I would be grateful, I want to highlight in teal if for example "David" or "Darren" or both are in Text10 field.

Any help gratefully received.

Sub text()

Dim Ctr As Integer

ViewApply "Gantt Chart"
OutlineShowAllTasks
FilterApply "All Tasks"
SelectAll

For Ctr = 1 To ActiveSelection.Tasks.Count
    SelectRow Row:=Ctr, rowrelative:=False
    If Not ActiveSelection.Tasks(1) Is Nothing Then
        If ActiveSelection.Tasks(1).Text10 = ("David") & ("Darren") Then
            Font Color:=pjTeal
        Else
            If ActiveSelection.Tasks(1).PercentComplete = 100 Then
                Font Color:=pjGreen
            Else
                If ActiveSelection.Tasks(1).PercentComplete = 0 Then
                    Font Color:=pjBlack
                Else
                    If ActiveSelection.Tasks(1).PercentComplete > 0 < 100 Then
                        Font Color:=pjBlue
                    Else
                    End If
                End If
            End If
        End If
    End If
Next Ctr

End Sub

Change:

If ActiveSelection.Tasks(1).Text10 = ("David") & ("Darren") Then

To:

If ActiveSelection.Tasks(1).Text10 = "David" Or ActiveSelection.Tasks(1).Text10 = "Darren" Then

Edit 1: Better style of coding (untested as I don't have MS-Project installed at home - can test it tomorrow morning)

Option Explicit

Sub text()

ViewApply "Gantt Chart"
OutlineShowAllTasks
FilterApply "All Tasks"

Dim T As Task

For Each T In ActiveProject.Tasks
    If Not T Is Nothing Then
        SelectRow T.UniqueID, RowRelative:=False '<-- there's no escape, in Ms-Project you need to select the Task's row in order to modify it's Font color
        If T.Text10 = "David" Or T.Text10 = "Darren" Then
            Font Color:=pjTeal
        Else
            Select Case T.PercentComplete
                Case 100
                    Font Color:=pjGreen
                Case 0
                    Font Color:=pjBlack
                Case Else
                    Font Color:=pjBlue
            End Select
        End If
    End If
Next T

End Sub

Edit 2: added a new logics for added information by PO.

Option Explicit

Sub ColorTasks()

ViewApply "Gantt Chart"
OutlineShowAllTasks
FilterApply "All Tasks"

Dim T As Task

For Each T In ActiveProject.Tasks
    If Not T Is Nothing Then
        SelectRow T.ID, RowRelative:=False

        Select Case T.Text10
            Case "David"
                 Font Color:=pjBlue
            Case "Mary"
                Font Color:=pjTeal
            Case "Bill"
                Font Color:=pjBlack
            Case "Sandra"
                Font Color:=pjPurple
        End Select

        ' I think you wanted this outside the case of the people in Text10
        If T.PercentComplete = 100 Then
            Font Color:=pjGreen
        Else
            If DateDiff("d", T.Finish, ActiveProject.CurrentDate) > 0 Then
                Font Color:=pjRed
            End If
        End If
    End If
Next T

End Sub
Sub test()

Dim Ctr As Integer

ViewApply "Gantt Chart"
OutlineShowAllTasks
FilterApply "All Tasks"
SelectAll
For Ctr = 1 To ActiveSelection.Tasks.Count
    SelectRow Row:=Ctr, rowrelative:=False
    If Not ActiveSelection.Tasks(1) Is Nothing Then
        If ActiveSelection.Tasks(1).Text10 = "David" Then
            Font Color:=pjBlue
        Else
        If ActiveSelection.Tasks(1).Text10 = "Mary" Then
            Font Color:=pjTeal
        Else
        If ActiveSelection.Tasks(1).Text10 = "Bill" Then
            Font Color:=pjBlack
        Else
        If ActiveSelection.Tasks(1).Text10 = "Sandra" Then
            Font Color:=pjPurple
        Else
        If ActiveSelection.Tasks(1).PercentComplete = 100 Then
            Font Color:=pjGreen
        Else    
        If ActiveSelection.Tasks(1).finish < currentdate Then 
            Font Color:=pjRed
        End If
        End If
        End If
        End If
        End If
        End If
        End If
    Next Ctr
End Sub

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM