如何将任务数据从Microsoft Project Plan复制到Excel? [英] how to copy tasks data from Microsoft Project Plan to excel?

问题描述

'~~> Code to open MPP file in Excel

Sub Sample()

Dim appProj As MSProject.Application
Dim aProg As MSProject.Project
Dim wb As Workbook
Dim ws As Worksheet

Set wb = ActiveWorkbook

'~~> This is the Sheet Where you want the data to be copied
Set ws = wb.Sheets("Sheet1")

Set appProj = CreateObject("Msproject.Application")

'~~> This is a MS Project File. Change path as applicable.
appProj.FileOpen "C:\MS Project.mpp"

Set aProg = appProj.ActiveProject

appProj.Visible = True

'~~> Now you have the MPP file opened, rest of the code goes here
End Sub

我已经成功打开了MPP文件，但是我想将特定的任务数据复制到Excel中，但是我不知道该怎么做，我的MPP有很多任务. 请帮忙.

I have successfully opened MPP file but I want to copy paticular task data to Excel.But I have no idea how to do it.My MPP has many tasks. Please Help.

我已经参考了以下链接，但是我无法获得如何将任务数据从MPP复制到Excel的代码 在此处输入链接描述

I have referred to the following link but I am unable to get the code how to copy tasks data from MPP to excel enter link description here

推荐答案

以下是一些可以激发您灵感的代码(Project VBA):

Here is some code (Project VBA) that can inspire you:

'This module contains macros which will export
'tasks to excel and keep the task hierarchy.
'modify as necessary to include other task information

'Copyright Jack Dahlgren, Feb 2002

Option Explicit
Dim xlRow As Excel.Range
Dim xlCol As Excel.Range
Sub TaskHierarchy()
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim Proj As Project
Dim t As Task
Dim Asgn As Assignment
Dim ColumnCount as Integer
Dim Columns as Integer
Dim Tcount As Integer

Set xlApp = New Excel.Application
xlApp.Visible = True
AppActivate "Microsoft Excel"

Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.Worksheets.Add
xlSheet.Name = ActiveProject.Name

'count columns needed
ColumnCount = 0
For Each t In ActiveProject.Tasks
    If Not t Is Nothing Then
        If t.OutlineLevel > ColumnCount Then
            ColumnCount = t.OutlineLevel
        End If
    End If
Next t

'Set Range to write to first cell
Set xlRow = xlApp.ActiveCell
xlRow = "Filename: " & ActiveProject.Name
dwn 1
xlRow = "OutlineLevel"
dwn 1

'label Columns
For Columns = 1 To (ColumnCount + 1)
    Set xlCol = xlRow.Offset(0, Columns - 1)
    xlCol = Columns - 1
Next Columns
rgt 2
xlCol = "Resource Name"
rgt 1
xlCol = "work"
rgt 1
xlCol = "actual work"
Tcount = 0
For Each t In ActiveProject.Tasks
    If Not t Is Nothing Then
        dwn 1
        Set xlCol = xlRow.Offset(0, t.OutlineLevel)
        xlCol = t.Name
            If t.Summary Then
                xlCol.Font.Bold = True
            End If
        For Each Asgn In t.Assignments
            dwn 1
            Set xlCol = xlRow.Offset(0, Columns)
            xlCol = Asgn.ResourceName
            rgt 1
            xlCol = (Asgn.Work / 480) & " Days"
            rgt 1
            xlCol = (Asgn.ActualWork / 480) & " Days"
        Next Asgn
        Tcount = Tcount + 1
    End If
Next t
AppActivate "Microsoft Project"

MsgBox ("Macro Complete with " & Tcount & " Tasks Written")
End Sub
Sub dwn(i As Integer)
Set xlRow = xlRow.Offset(i, 0)
End Sub

Sub rgt(i As Integer)
Set xlCol = xlCol.Offset(0, i)
End Sub

来源

这篇关于如何将任务数据从Microsoft Project Plan复制到Excel?的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！