最新消息:雨落星辰是一个专注网站SEO优化、网站SEO诊断、搜索引擎研究、网络营销推广、网站策划运营及站长类的自媒体原创博客

vba - excel to ms project - Stack Overflow

programmeradmin0浏览0评论

Hi am found macros which can add values to dates, but this needs to be written manually for each value. is there a more universal method for transferring EXCEL values to MS PROJECT?

Sub SetActualHours1()
    Dim tsk As Task
    Dim names As String
    For Each tsk In ActiveProject.Tasks
            Dim asn As Assignment
            For Each asn In tsk.Assignments
                If asn.UniqueID = 2097154 Then  '  ID Resource (UID =1048578, [1048578+1048576=2097154]
                    Dim tsv As TimeScaleValues
                    Set tsv = asn.TimeScaleData(StartDate:=#2/4/2025#, EndDate:=#2/16/2025# _
                        , Type:=pjAssignmentTimescaledActualWork, TimeScaleUnit:=pjTimescaleDays)
                    ' tsv(1).Clear
                     tsv(1).Value = 7
                     tsv(2).Value = 8
                     tsv(3).Value = 12
                     tsv(4).Value = 25
                     tsv(7).Value = 4
                     tsv(8).Value = 7
                     tsv(9).Value = 24
                     tsv(10).Value = 78
                     tsv(11).Value = 5
                End If
            Next asn
    Next tsk
End Sub

Hi am found macros which can add values to dates, but this needs to be written manually for each value. is there a more universal method for transferring EXCEL values to MS PROJECT?

Sub SetActualHours1()
    Dim tsk As Task
    Dim names As String
    For Each tsk In ActiveProject.Tasks
            Dim asn As Assignment
            For Each asn In tsk.Assignments
                If asn.UniqueID = 2097154 Then  '  ID Resource (UID =1048578, [1048578+1048576=2097154]
                    Dim tsv As TimeScaleValues
                    Set tsv = asn.TimeScaleData(StartDate:=#2/4/2025#, EndDate:=#2/16/2025# _
                        , Type:=pjAssignmentTimescaledActualWork, TimeScaleUnit:=pjTimescaleDays)
                    ' tsv(1).Clear
                     tsv(1).Value = 7
                     tsv(2).Value = 8
                     tsv(3).Value = 12
                     tsv(4).Value = 25
                     tsv(7).Value = 4
                     tsv(8).Value = 7
                     tsv(9).Value = 24
                     tsv(10).Value = 78
                     tsv(11).Value = 5
                End If
            Next asn
    Next tsk
End Sub
Share Improve this question edited Feb 6 at 17:55 braX 11.8k5 gold badges22 silver badges37 bronze badges asked Feb 6 at 16:17 RomanRoman 94 bronze badges
Add a comment  | 

2 Answers 2

Reset to default 1

I don't have ms project to test but basic idea is work

Option Explicit

Sub SetActualHours4()
    
    Const OFFSET As Long = 1048576 ' uid correction 2^20

    Dim xlApp As Excel.Application
    Dim wb As Excel.Workbook, ws As Excel.Worksheet
    Dim lastrow As Long, r As Long, c As Long, uid As Long
    Dim bFound As Boolean
    Dim wbLog As Excel.Workbook, i As Long, n As Long
    
    ' open excel sheet
    Set xlApp = CreateObject("Excel.Application")
    xlApp.Visible = True
    Set wb = xlApp.Workbooks.Open("taskdata.xlsx")
    Set ws = wb.Sheets(1)
    
    'Set wbLog = xlApp.Workbooks.Add
    
    ' scan down sheet
    lastrow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    For r = 2 To lastrow
        uid = ws.Cells(r, 1)
        
        'i = i + 1
        'wbLog.Sheets(1).Cells(i, 1) = uid
        
        Dim tsk As Task
        Dim names As String
        bFound = False

        For Each tsk In ActiveProject.Tasks
             Dim asn As Assignment
             For n = 1 To tsk.Assignments.Count
                Set asn = tsk.Assignments(n)
             
                'i = i + 1
                'wbLog.Sheets(1).Cells(i, 2) = asn.UniqueID
                
                If asn.UniqueID = uid + OFFSET Then
                    bFound = True
                    Dim tsv As TimeScaleValues
                    Set tsv = asn.TimeScaleData(StartDate:=#2/4/2025#, EndDate:=#2/16/2025# _
                            , Type:=pjAssignmentTimescaledActualWork, TimeScaleUnit:=pjTimescaleDays)
                        
                    For c = 2 To 13
                        If ws.Cells(r, c) > 0 Then
                        
                           tsv(c - 1).Value = ws.Cells(r, c) * 60
                            Debug.Print ws.Cells(r, c)
                        Else
                            tsv(c - 1).Clear
                        End If
                    Next
                End If
            Next
        Next
        If bFound = False Then MsgBox uid & " not found"
    Next
    
    ' close excel
    'wbLog.SaveAs "log.xlsx"
    'wbLog.Close
    wb.Close savechanges:=False
    xlApp.Quit
   
End Sub

I'm going to post this as an answer rather than continue the growing comments. I downloaded Roman's files and ran the macro. It erred on the tsv(c - 1).Value = ws.Cells(r, c) line with the error of an invalid value.

Yesterday I made a comment about needing to convert Excel time values to minutes in order for the value to be properly interpreted by Project. Then I backed off on that as I saw the macro was set up to import "pjTimescaledDays. Well wrong again, I dug up a macro I wrote a couple of years ago that did essentially the same thing Roman is trying to do. The bottom line: Yes the Excel data must be converted to minutes even though the timescale units is set for "pjTimescaleDays".

There is also an error with the clear statement. The error occurs on the last clear. For some reason the timescale values (Locals window) shows 12 elements when there should be 13 elements (i.e. 2/4/25 through 2/16/25). I didn't have time to find out why the difference but changing the loop to go from 2 to 13 eliminates that error for this data export.

发布评论

评论列表(0)

  1. 暂无评论