MS Project to Excel Gantt Chart using VBA Follow On

Question

@shai-rado

嗨 - 这是

的后续问题

MS Project to Excel Gantt Chart using VBA

Sub ExportToExcel()

Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim proj As Project
Dim t As Task
Dim pj As Project
Dim pjDuration As Integer
Dim i As Integer
Set pj = ActiveProject
Set xlApp = New Excel.Application
xlApp.Visible = True
'AppActivate "Excel"
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.Worksheets(1)
xlSheet.cells(1, 1).Value = "Project Name"
xlSheet.cells(1, 2).Value = pj.Name
xlSheet.cells(2, 1).Value = "Project Title"
xlSheet.cells(2, 2).Value = pj.Title
xlSheet.cells(1, 4).Value = "Project Start"
xlSheet.cells(1, 5).Value = pj.ProjectStart
xlSheet.cells(2, 4).Value = "Project Finish"
xlSheet.cells(2, 5).Value = pj.ProjectFinish

xlSheet.cells(1, 7).Value = "Project Duration"
pjDuration = pj.ProjectFinish - pj.ProjectStart
xlSheet.cells(1, 8).Value = pjDuration & "d"

xlSheet.cells(4, 1).Value = "Task ID"
xlSheet.cells(4, 2).Value = "Task Name"
xlSheet.cells(4, 3).Value = "Task Start"
xlSheet.cells(4, 4).Value = "Task Finish"

' Add day of the week headers for the entire Project's duration
For i = 0 To pjDuration
    xlSheet.cells(4, i + 5).Value = pj.ProjectStart + i
    xlSheet.cells(4, i + 5).NumberFormat = "[$-409]d-mmm-yy;@"
Next

For Each t In pj.Tasks
    xlSheet.cells(t.ID + 4, 1).Value = t.ID
    xlSheet.cells(t.ID + 4, 2).Value = t.Name
    xlSheet.cells(t.ID + 4, 3).Value = t.Start
    xlSheet.cells(t.ID + 4, 3).NumberFormat = "[$-409]d-mmm-yy;@"
    xlSheet.cells(t.ID + 4, 4).Value = t.Finish
    xlSheet.cells(t.ID + 4, 4).NumberFormat = "[$-409]d-mmm-yy;@"

    For i = 5 To pjDuration + 5
        'Loop to add day of week headers and color cells to mimic Gantt chart
        If t.Start <= xlSheet.cells(4, i) And t.Finish >= xlSheet.cells(4, i) Then
            xlSheet.cells(t.ID + 4, i).Interior.ColorIndex = 37
        End If
     Next i
Next t

嗨 - 我是 Project Macros 的新手，所以我想我会从你的 代码如何在 Project 2013 中运行它时出现“编译错误： 在 Dim xlApp As Excel.Application 上未定义用户定义的类型 命令。在那里阅读（stackoverflow.com/questions/19680402/...） 似乎已经改变了代码的格式。它是否正确 或者我是否需要像我一样在我自己的项目设置中查看其他位置 有没有想过代码向后兼容？提前感谢T

这段代码我也遇到了同样的问题，所以我认为有一个共同的主题？

Public Sub Excel()
    ' This code will import timesheet data from an Excel spreadsheet as ActualWork in your
    ' project schedule.

    ' Your Excel file must have a named range, "TimeSheetEntries", which has 
    ' 5 columns: EntryNumber, WBS, Employee, Date, and Minutes. 
    ' Don't include any column headers in the named range.

    ' EntryNumber is a unique ID coming from our legacy time sheet application. It will be 
    ' added to the assignment.Notes field, but has does not affect any program logic.

    ' WBS is the key used to reference the appropriate task. This means that either you
    ' or your resources have to enter this code when entering data in their time sheets.

    ' Employee is the resource's name, and it must match up with the resource names in
    ' your assignments.

    ' Date is... the date for the work sheet entry. One entry per day please - this code will
    ' not handle a range of dates.

    ' Minutes is the number of minutes that the resource spent on this particular task, on this 
    ' particular day.

    ' So if Joe Schmo worked for 3 1/2 hours on task WBS-3.2.2 on the 13th of June 2013, and
    ' your timesheet application assigned this entry the identifier "36894", the row in Excel should
    ' look like this:

    '        36894        WBS-3.2.2        Schmo, Joe        06/13/2013        210

    ' If your data contains entries from resources who were not assigned to the entries task, 
    ' their data will not be added. The VBA debug window will contain a list of the unassigned entries.
    ' You need to go back and determine why someone is doing work they were not assigned to.
    ' If the work is valid, you can either add them to the task's resources, or add a new task and
    ' have them resubmit the data with the new WBS code.

    Dim assignment As assignment
    Dim c As Excel.Range
    Dim oExcel As Excel.Application
    Dim oWB As Excel.Workbook
    Dim Row As Excel.Range
    Dim task As task
    Dim tsv As TimeScaleValue
    Dim tsvs As TimeScaleValues
    Dim FoundAssignment As Boolean

    Set oExcel = New Excel.Application
    Set oWB = oExcel.Workbooks.Open(FileName:="path to excel file", ReadOnly:=True)

    For Each Row In Range("TimeSheetEntries").Rows
        FoundAssignment = False
        EntryNumber = Row.Cells(1, 1)
        WBS = Row.Cells(1, 2)
        Employee = Row.Cells(1, 3)
        MyDate = Row.Cells(1, 4)
        Minutes = Row.Cells(1, 5).Value

        FilterEdit Name:=    "Update_Actual_Work", _
                                      TaskFilter:=True, _
                                      Create:=True, _
                                      OverwriteExisting:=True, _
                                      FieldName:="WBS", _
                                      Test:="equals", _
                                      Value:=WBS

        FilterApply Name:="Update_Actual_Work"

        SelectAll

        Set task = ActiveSelection.Tasks(1)

        For Each assignment In task.Assignments
            If (StrComp(assignment.ResourceName, Employee) = 0) Then
                FoundAssignment = True
                Set tsvs = assignment.TimeScaleData(Startdate:=MyDate, EndDate:=MyDate, _
                         Type:=pjAssignmentTimescaledActualWork, TimeScaleUnit:=pjTimescaleDays, _
                         Count:=1)
                tsvs(1).Value = Minutes
                assignment.Notes = assignment.Notes & EntryNumber & vbCrLf
                Exit For
            End If
        Next
        FilterClear
        If Not FoundAssignment Then Debug.Print EntryNumber & vbTab & "not allocated"
    Next

    oWB.Close
    Set oWB = Nothing
    oExcel.Quit

End Sub

Answer 1

设法解决了这个基本问题...您需要进入宏屏幕，进入工具和参考 - 根据需要勾选 Excel 等。

谢谢

T