为Project 甘特图的条形图上加上任务名称和工期的代码

sos001

Project 甘特图的条形图，默认在右侧出现资源名称，作为甘特图来说，信息不够充分，看起来信息量少。


下面的代码可以为Project 甘特图的条形图上，在左侧加上任务名称，在上方加上工期，右侧加上资源名称。


Sub Add_Left_up_right_On_Bar()
' 宏 Macro1
' H 在 23-4-20 记录的宏。

On Error GoTo error_handler
    Dim PJT As MSProject.Task
   
    Dim Pname As String
    Dim TaskN As Integer
    Pname = ActiveProject.Name
    TaskN = ActiveProject.NumberOfTasks
   
   
    ' 移动到第一行
    SelectTaskField Row:=1, Column:="名称", RowRelative:=False
   
   
   
    ' 遍历所有条形图，并设置相应的文本框内容
   
    For Each PJT In ActiveProject.Tasks
        GanttBarFormatEx LeftText:="名称", RightText:="资源名称", TopText:="工期"
        SelectRow Row:=1
    Next
    Set PJT = Nothing
   

Exit Sub
error_handler:
    If Err.Number <> 0 Then
    MSG = "Error # " & Str(Err.Number) & " was generated by " _
            & Err.Source & Chr(13) & Err.Description
    MsgBox MSG, , "Error", Err.HelpFile, Err.HelpContext
    End If
   
    If Err.Number = 462 Then
        MsgBox "请关闭" & Pname & " 文件，选择不保存，再重新打开。"
   
    End If
    Set PJT = Nothing
End Sub