在 MS-project 中按任务名称自动添加资源

Question

我想为 MS 项目中的某些任务（子任务）自动添加资源名称例如如果任务是 CMM 我想自动将 CMM 添加到资源名称这是我的代码

Sub Automatically()
Dim NR As MsProject.Resource
Dim Tsk As MsProject.Task
Dim Row As Integer
For each row in Ms.Project.Task
          If Tsk = "CMM" Or "EDM" Or "EL Milling" Or "CAM Wire cut" Or "Laser Welding" Or "Wire cut" Or "CNC Milling" Or "Grinding" Or "Lathe" Or "Manual Milling" Or "Polishing"
               Set NR = NR.Resource.Add.Tsk
          End If
          If Tsk = "Inspection" Or "Report" Then
               Set NR =  "CMM"
          End if
Next row
End Sub

Answer 1

此代码根据任务名称为任务分配资源。鉴于任务名称通常比单个词更具描述性，代码使用 contains 搜索（例如 Like）。如果该资源尚不存在，则添加它。

Sub AddResourceAssignments()

    Dim resName As String

    Dim tsk As Task
    For Each tsk In ActiveProject.Tasks
        ' determine the resource to add to the task
        Select Case True
            Case (tsk.Name Like "*Gate*"): resName = "Gate"
            Case (tsk.Name Like "*CMM*"): resName = "CMM"
            Case (tsk.Name Like "*EDM*"): resName = "EDM"
            Case (tsk.Name Like "*EL Milling*"): resName = "EL Milling"
            Case (tsk.Name Like "*CAM Wire cut*"): resName = "CAM Wire cut"
            Case (tsk.Name Like "*Laser Welding*"): resName = "Laser Welding"
            Case (tsk.Name Like "*Wire cut*"): resName = "Wire cut"
            Case (tsk.Name Like "*CNC Milling*"): resName = "CNC Milling"
            Case (tsk.Name Like "*Grinding*"): resName = "Grinding"
            Case (tsk.Name Like "*Lathe*"): resName = "Lathe"
            Case (tsk.Name Like "*Manual Milling*"): resName = "Manual Milling"
            Case (tsk.Name Like "*Polishing*"): resName = "Polishing"
            Case (tsk.Name Like "*Inspection*"): resName = "CMM"
            Case (tsk.Name Like "*Report*"): resName = "CMM"
            Case Else: resName = vbNullString
        End Select

        If Len(resName) > 0 Then
            ' create the resource assignment
            On Error Resume Next
            Dim res As Resource
            Set res = ActiveProject.Resources(resName)
            If Err.Number <> 0 Then
                ' presume error due to missing resource
                Set res = ActiveProject.Resources.Add(Name:=resName)
            End If
            tsk.Assignments.Add ResourceID:=res.ID
        End If

    Next tsk

End Sub

在 MS-project 中按任务名称自动添加资源

Add resource automatically by task name in MS-project

vba

ms-project