MS项目到Excel甘特图使用VBA关注 [英] MS Project to Excel Gantt Chart using VBA Follow On

问题描述

@ shai-rado

@shai-rado

嗨 - 这是

使用VBA的Excel甘特图的项目

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中运行它时，会得到一个Complie错误：
用户定义的类型未定义在Dim xlApp上作为Excel.Application
命令。读取（stackoverflow.com/questions/19680402/...）那里有
似乎已经改变了代码的格式。这是正确的
还是我需要看别的地方在我自己的项目设置，因为我将
认为代码向后兼容？感谢提前T

Hi - I'm new to Project Macros so I thought I would start with your code how ever when running it in Project 2013 I get a "Complie error: User-defined type not defined" on the Dim xlApp As Excel.Application command. Reading up ( stackoverflow.com/questions/19680402/… ) there seems to have been changes to the format of the code. Is this correct or do I need to look else where on my own Project set up as I would have thought the code backwards compatible ? Thanks in advance T

我也有同样的问题，这个代码，所以我想有一个共同的主题？ p>

I've also had the same problem with this code so I am thinking there is a common theme ?

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

推荐答案

设法解决这个基本问题...你需要去宏屏幕，得到工具和参考 - 根据需要勾选Excel等。

managed to work out this basic issue... you need to go to the Macro Screen, got to Tool and References - tick Excel etc as needed.

谢谢

T

这篇关于MS项目到Excel甘特图使用VBA关注的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！