MS Project 的 VB 代码

Question

我正在尝试让下面的代码（MS Project 文本颜色更改）工作，但当我将其放入 MPP 中的模块时，它给出了一个错误。这可能是我的问题，而不是代码的问题。

此代码应该查看状态并相应地更改文本颜色。我将此代码剪切并粘贴到模块中，但运行时出现错误，提示编译错误。

然后它突出显示下面的第二行。

Sub CompletePercentSub()

Dim t As Task Dim i As Integer

'Iterates through the entire ms project file

i = 1 For Each t In ActiveProject.Tasks

SelectRow Row:=i, RowRelative:=False

If Not t Is Nothing Then

    Select Case t.Status
        Case 0 'Complete
            Font32Ex CellColor:=&H98FB98 'LIGHT GREEN
        Case 1 'On Schedule
            Font32Ex CellColor:=&HE0FFFF 'TAN
        Case 2 'Late
            Font32Ex CellColor:=&HC0FF& 'LIGHT RED
        Case 2 'Future Task
            Font32Ex CellColor:=&HFFFFFF 'WHITE
    End Select
End If
i = i + 1

Next t

End Sub

Answer 1

以下是上述宏的更正版本：

Sub CompletePercentSub()

Dim t As Task
Dim i As Integer

i = 1
For Each t In ActiveProject.Tasks
    SelectRow Row:=i, RowRelative:=False
    If Not t Is Nothing Then
        Select Case t.Status
            Case 0 'Complete
                Font32Ex CellColor:=&H98FB98 'LIGHT GREEN
            Case 1 'On Schedule
                Font32Ex CellColor:=&HE0FFFF 'TAN
            Case 2 'Late
                Font32Ex CellColor:=&HC0FF& 'LIGHT RED
            Case 3 'Future Task
                Font32Ex CellColor:=&HFFFFFF 'WHITE
        End Select
    End If
    i = i + 1
Next t

End Sub

这是基于您之前（现已删除）的问题的替代版本。请根据需要进行调整。

Sub FormatTasksByStatus()

    FilterClear
    OutlineShowAllTasks
    
    SelectAll
    Font32Ex Color:=RGB(255, 255, 255), CellColor:=RGB(0, 0, 0)
    
    Dim NumTasks As Long
    NumTasks = ActiveProject.Tasks.Count
    Dim i As Long
    
    For i = 1 To NumTasks
        SelectRow Row:=i, RowRelative:=False
        On Error Resume Next
        Dim tsk As Task
        Set tsk = ActiveCell.Task
        If Err.Number = 0 Then
            Dim cc As Long
            cc = RGB(255, 255, 255)
            Dim fc As Long
            fc = RGB(0, 0, 0)
            
            If tsk.PercentComplete = 100 Then
                fc = RGB(128, 128, 128)         ' complete = grey
            
            ElseIf tsk.PercentComplete = 0 Then
                If Fix(tsk.Start) < Date Then
                    fc = RGB(255, 0, 0)         ' late start = red
                ElseIf Fix(tsk.Start) < (Date + 5) Then
                    cc = RGB(255, 255, 0)       ' starting soon = yellow
                End If
                
            ElseIf tsk.PercentComplete < 100 Then
                If Fix(tsk.Finish) < Date Then
                    fc = RGB(255, 0, 0)         ' late finish = red
                ElseIf Fix(tsk.Finish) < (Date + 3) Then
                    cc = RGB(255, 255, 0)       ' finishing soon = yellow
                Else
                    fc = RGB(0, 0, 255)         ' finishing later = blue
                    If IsDate(tsk.BaselineStart) Then
                        If tsk.Start < tsk.BaselineStart Then
                            cc = RGB(0, 255, 0) ' green = started early
                        End If
                    End If
                   
                End If
                
            End If
            Font32Ex Color:=fc, CellColor:=cc
        End If
        Err.Clear
    Next i

End Sub