【问题标题】:MS (Project) Find Strings in text10 and change font colorMS(项目)在 text10 中查找字符串并更改字体颜色
【发布时间】:2017-08-23 08:57:21
【问题描述】:

我正在根据完成百分比和 text10 列中的名称更改 MS Project 中的字体颜色。百分比有效,但是有人能给我指导一下我会感激的名字吗,如果例如“David”或“Darren”或两者都在Text10字段中,我想用蓝绿色突出显示。

感谢您的任何帮助。

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

【问题讨论】:

  • 未来的你(和/或你的代码的未来维护者)会高兴有这样的缩进...查看我的 OSS 项目的@987654321 @,它会自动为您解决此问题。
  • @Mat'sMug 一定会喜欢 Ducky :)

标签: vba fonts colors ms-project


【解决方案1】:

变化:

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

收件人:

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

编辑 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

编辑 2:为 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

【讨论】:

  • 循环遍历任务集合并使用带有任务唯一 ID 的 SelectRow 仅在没有删除任务(任务 ID = 任务唯一 ID)、不存在外部任务且视图按任务 ID 排序。 OP 的选择任务和循环选择的版本效果更好。
  • 非常感谢您的帮助,如果我需要添加一行来说明如果今天的日期大于完成日期,请将字体更改为红色。会是下面这样吗?
  • If ActiveSelection.Tasks(1).finish
  • 由于某种原因,蓝绿色不起作用,所以我使用了以下内容。
【解决方案2】:
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

【讨论】:

  • 如果今天的日期大于完成日期并且完成百分比小于 100,则代码正在使用能够将字体突出显示为红色的例外情况。如果您能提供帮助,我将不胜感激用那个或指出我可以解决的地方吗?
  • 在我上面的答案中尝试 EDIT 2 下的代码 - 我认为这就是你想要的
  • 这就像做梦一样,非常感谢您的帮助,我要疯了才能让它工作。亲切的问候 VBvirg20
猜你喜欢
  • 1970-01-01
  • 2015-01-12
  • 2019-02-18
  • 2021-11-16
  • 2012-04-13
  • 2013-08-02
  • 1970-01-01
  • 1970-01-01
相关资源
最近更新 更多