使用任務將具有相同ID的Excel數據添加到MS項目 - VBA

在Excel中，我在第二行（第一行= header）開始的列「A」中有ID'數字。在「T」列中，我在同一行有一個ID的持續時間。使用任務將具有相同ID的Excel數據添加到MS項目 - VBA

在MS Project中，我有一個ID列和一個空的持續時間列。我想在正確的ID行上添加從excel到MS Project的持續時間。

我想我可以通過使用任務和For..To循環來做到這一點。我將需要在Excel中使用ID來查找MS Project中的任務，然後在Excel中寫入適當任務中Excel的持續時間。到目前爲止，有一定的幫助，我的代碼是：

'Find duration and assign to ID in Excel 
For i = 2 To lastRow 
date1 = .Cells(i, 15) 
date2 = .Cells(i, 16) 
    If .Cells(i, 18).Value = "No" Then 
    answer = DateDiff("n", date1, date2) 
    .Cells(i, 20) = answer 
    End If 
durationID = .Cells(i,1).Value 
Next i 

'Open MS Project and add Duration column 
set wb = ActiveWorkBook 
Set ws = wb.Sheets("Task_Table1") 
Set appProj = CreateObject("Msproject.Application") 
appProj.FileOpen "File1.mpp" 
Set aProg = appProj.ActiveProject 
appProj.Visible = True 


lastTask = ActiveProject.Tasks.Count 
taskID = ActiveProject.Tasks.ID 

'Load Durations into MS Project to appropriate ID task 
lastTask = ActiveProject.Tasks.Count 
For i = 1 to lastTask 
    If taskID = Application.Workbooks("File1").Sheets("Task_Table1").Cells(i, 1).Value Then 
    answer.Copy 
    appProj.SelectCell.ActiveCell 
    end if 
Next i

來源

2017-06-21 Peel

複製時間到用戶界面代替，直接分配持續時間的任務目標。或者（根據下面的評論），更新實際開始日期和實際完成日期。包含兩者的代碼，但如果您要更新「實際開始」和「實際完成」，則更新持續時間也沒有意義。

'Open MS Project 
Set appProj = CreateObject("MSProject.Application") 
appProj.FileOpen "File1.mpp" 
Set aProg = appProj.ActiveProject 
appProj.Visible = True 

'Find duration and assign to task 
Dim Duration As Long 
Dim tsk as MSProject.Task 
With ws 
    For i = 2 To lastRow 
     date1 = .Cells(i, 15) 
     date2 = .Cells(i, 16) 
     ' get a reference to the task object using the ID stored in Column A 
     Set tsk = aProg.Tasks(.Cells(i, 1).Value) 
     ' Update duration 
     If .Cells(i, 18).Value = "No" And IsDate(date1) And IsDate(date2) Then 
      TotalMinutes = DateDiff("n", date1, date2) 
      WorkingMinutes = appProj.DateDifference(date1, date2) 
      .Cells(i, 20) = WorkingMinutes 
      tsk.Duration = WorkingMinutes 
     End If 
     ' update Actual Start and/or Actual Finish 
     If IsDate(date1) Then 
      tsk.ActualStart = date1 
     End If 
     If IsDate(date2) Then 
      tsk.ActualFinish = date2 
     End If 
    Next i 
End With

請注意，有兩個計算包括持續時間。 VBA DateDiff函數返回兩個日期之間的總分鐘數，而MS Project DateDifference函數返回兩個日期之間的工作分鐘數。後者可能是你想要使用的。否則，1天的持續時間（1440分鐘）將變成3天的任務（1440 = 3天* 8小時* 60分鐘/小時）。

來源

2017-06-21 17:27:34

爲了簡化整個過程，Excel中的日期已經在「實際開始」和「實際完成」下的自己的列中。許多實際的開始和結束日期都是「不適用」，這會使DateDifference不起作用嗎？如果它能工作，我可以保持這一點對於功能和更改日期變量等於MS Project中的單元格？例如： 'date1 = .Cells（i，「Actual Start」）' – Peel

此外，結果將打印在哪裏？我需要事先製作一個專欄嗎？ – Peel

您是否確實需要更新實際開始日期和實際完成日期而不是持續時間？如果需要，可以在Excel中存儲TotalMinutes或WorkingMinutes變量;我會爲此更新代碼。 –

使用任務將具有相同ID的Excel數據添加到MS項目 - VBA

回答

相關問題