[英]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.我正在根据完成百分比和 text10 列中的名称更改 MS Project 中字体的颜色。 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.百分比有效,但是有人可以指导我使用哪些名称,我将不胜感激,如果例如“David”或“Darren”或两者都在
Text10
字段中,我想用青色突出显示。
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)编辑 1:更好的编码风格(未经测试,因为我家里没有安装 MS-Project - 明天早上可以测试)
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
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
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.