根据 MS Project VBA 中的任务级别更改背景行颜色答案

【问题标题】：Changing background row color according to task levels in MS Project VBA根据 MS Project VBA 中的任务级别更改背景行颜色
【发布时间】：2015-09-18 05:05:35
【问题描述】：

您好，我一直在尝试找出代码，以便根据任务级别为不同的行着色。我是 MS Project 中的 VBA 新手。我有一个我在网上找到的代码，但它只为任务列中的文本着色。

Sub ColorFormatOL()
Dim t As Task
Dim i As Integer
SelectTaskColumn
  i = 0
For Each t In ActiveSelection.Tasks
   If Not t Is Nothing Then
       i = i + 1
   If t.Summary Then
       SelectRow row:=i, Columrowrelative:=False
       Select Case t.OutlineLevel
           Case 1
               FontEx Color:=pjRed
           Case 2
               FontEx Color:=pjGreen
           Case 3
               FontEx Color:=pjTeal
        End Select
    End If
  End If
 Next t
End Sub

【问题讨论】：

标签： vba ms-project

【解决方案1】：

我玩弄了一下代码并找到了答案：D

Sub ColorFormatOL()
Dim t As Task
Dim i As Integer

i = 1
For Each t In ActiveProject.Tasks


       SelectRow row:=i, rowrelative:=False

       Select Case t.OutlineLevel
           Case 1
           Font32Ex CellColor:=&HB37F15
           Case 2
           Font32Ex CellColor:=&HD6982E
           Case 3
           Font32Ex CellColor:=&HF6BE41
           Case 4
           Font32Ex CellColor:=&HF7D577


       End Select

i = i + 1
Next t
End Sub

【讨论】：

【解决方案2】：

这是我使用的一个宏：

公共子格式Outline_Blue() 呼叫格式OutlineLevels(9851951, 14396046, 15189684, 14084850, 15791610, 16777215, 16777215, 16777215, 16777215, 16777215) 结束子公共子格式Outline_Green() 呼叫格式OutlineLevels(4697456, 9293992, 11788485, 14084850, 15791610, 16777215, 16777215, 16777215, 16777215, 16777215) 结束子公共子格式Outline_Aqua() 呼叫格式OutlineLevels(13998939, 15057820, 15652797, 14084850, 15791610, 16777215, 16777215, 16777215, 16777215, 16777215) 结束子 Private Sub FormatOutlineLevels(level1 为字符串，level2 为字符串，level3 为字符串，level4 为字符串，level5 为字符串，level6 为字符串，level7 为字符串，level8 为字符串，level9 为字符串，可选 font1 为字符串) '格式化大纲级别。宏过滤到摘要任务，选择整个工作表，显示大纲级别 x，格式化整个工作表。 '接下来，它显示一个大纲级别（x - 1），格式化整个工作表。 '最后，它删除了非活动摘要任务的格式。 '准备 On Error GoTo ErrorHandler 保存原始设置大纲显示所有任务 FilterApply Name:="摘要任务" 选择表 '格式化所有行，从这个大纲级别开始 OutlineShowTasks OutlineNumber:=pjTaskOutlineShowLevel9 Font32Ex CellColor:=level9 OutlineShowTasks OutlineNumber:=pjTaskOutlineShowLevel8 Font32Ex CellColor:=level8 OutlineShowTasks OutlineNumber:=pjTaskOutlineShowLevel7 Font32Ex CellColor:=level7 OutlineShowTasks OutlineNumber:=pjTaskOutlineShowLevel6 Font32Ex CellColor:=level6 OutlineShowTasks OutlineNumber:=pjTaskOutlineShowLevel5 Font32Ex CellColor:=level5 OutlineShowTasks OutlineNumber:=pjTaskOutlineShowLevel4 Font32Ex CellColor:=level4 OutlineShowTasks OutlineNumber:=pjTaskOutlineShowLevel3 Font32Ex CellColor:=level3 OutlineShowTasks OutlineNumber:=pjTaskOutlineShowLevel2 Font32Ex CellColor:=level2 OutlineShowTasks OutlineNumber:=pjTaskOutlineShowLevel1 Font32Ex CellColor:=level1 If Len(font1) > 0 Then Font32Ex 颜色:=font1 '从非活动的摘要任务中删除格式屏幕更新 = 假大纲显示所有任务 FilterEdit Name:="Inactive Summary Tasks", TaskFilter:=True, Create:=True, OverwriteExisting:=True, FieldName:="Summary", test:="equals", Value:="yes", ShowInMenu:=False , ShowSummaryTasks:=假 FilterEdit Name:="Inactive Summary Tasks", TaskFilter:=True, FieldName:="", NewFieldName:="Active", test:="equals", Value:="no", Operation:="And", ShowSummaryTasks :=假 FilterApply Name:="非活动摘要任务" 选择表编辑清除格式屏幕更新 = 真 '清理 FilterApply 名称：="所有任务" 恢复原始设置级联大纲退出子错误处理程序：处理错误结束子公共子级联大纲（）出错时继续下一步 OutlineShowTasks OutlineNumber:=pjTaskOutlineShowLevel9 OutlineShowTasks OutlineNumber:=pjTaskOutlineShowLevel8 OutlineShowTasks OutlineNumber:=pjTaskOutlineShowLevel7 OutlineShowTasks OutlineNumber:=pjTaskOutlineShowLevel6 OutlineShowTasks OutlineNumber:=pjTaskOutlineShowLevel5 OutlineShowTasks OutlineNumber:=pjTaskOutlineShowLevel4 OutlineShowTasks OutlineNumber:=pjTaskOutlineShowLevel3 OutlineShowTasks OutlineNumber:=pjTaskOutlineShowLevel2 SelectRow Row:=1, rowrelative:=False 错误转到 0 结束子私有子处理错误（）选择 Case Err.Number 案例 91 MsgBox "您选择的第一行缺少任务名称。", vbCritical 案例 424 MsgBox "您选择的行可能缺少任务名称。", vbCritical 案例 1100 MsgBox "此视图和表格组合没有可用的大纲。请尝试转到 " & _ “查看>>数据组：大纲。如果大纲显示为灰色，请尝试单击任务名称。” &_ vbNewLine & vbNewLine & "此错误通常发生在选择时间线或详细信息窗格时。", _ vbCritical，“糟糕！大纲不可用” 案例 1101 MsgBox "尝试在任务表视图上使用这个宏。" & vbNewLine & vbNewLine & _ "错误#" & Str(Err.Number) & " - " & Err.Description, vbCritical, "无效视图" 其他情况 MsgBox "Error#" & Str(Err.Number) & " - " & Err.Description & vbNewLine _ & "行：" & Erl & vbNewLine _ , vbCritical 结束选择结束子

【讨论】：