Добавление ресурса автоматически по имени задачи в MS-проекте - PullRequest
Новая
       25

Добавление ресурса автоматически по имени задачи в MS-проекте

1 голос
/ 03 ноября 2019

Я хочу автоматически добавить имя ресурса только для некоторой задачи (подзадачи) в 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

1 Ответ

1 голос
/ 03 ноября 2019

Этот код назначает ресурсы задачам на основе названий задач. Учитывая, что имена задач обычно более описательны, чем одно слово, код использует содержит поиск (например, 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
...