MS Project VBA：尝试将复制的任务从.MPP粘贴到Excel

Question

我试图将任务从MS Project中的特定过滤器复制到Excel文档。这是我到目前为止所拥有的;但是，我无法将任务粘贴到工作簿上。任何援助都会很棒。

    Public Sub Export_TopbarToExcel()

    Dim xlApp As Excel.Application
    Dim xlBook As Excel.Workbook
    Dim xlSheet As Excel.Worksheet
    Dim t As Task
    Dim pj As Project

    Set pj = ActiveProject
    Set xlApp = New Excel.Application

    xlApp.Visible = True
    'applies filter in project
    FilterApply Name:="TopBarReport"
    'selects filtered tasks and copies them
    SelectAll
    EditCopy

    'adds new workbook
    Set xlBook = xlApp.Workbooks.Add
    Set xlSheet = xlBook.Worksheets(1)

    'Add the project header info in the top 2 rows
    xlSheet.Cells(1, 1).Value = "Status Date"
    xlSheet.Cells(1, 2).Value = pj.StatusDate
    xlSheet.Cells(1, 3).Value = "Project Title"
    xlSheet.Cells(1, 4).Value = pj.Title
    'here is where the issue is...it is not pasting the selected info here
    xlSheet.Activate
        Range("A3").Activate
        EditPaste

    MsgBox "Done", vbInformation

    End Sub

Answer 1

EditPaste是一种Project方法，因此很可能只是复制和覆盖相同的内容。

此外，Excel中的活动可能会导致复制过程被取消。

将EditCopy进一步向下移动并使用xlSheet.Paste或Range的PasteSpecial方法获取Excel中的内容。

'EditCopy

'adds new workbook
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.Worksheets(1)

'Add the project header info in the top 2 rows
xlSheet.Cells(1, 1).Value = "Status Date"
xlSheet.Cells(1, 2).Value = pj.StatusDate
xlSheet.Cells(1, 3).Value = "Project Title"
xlSheet.Cells(1, 4).Value = pj.Title
'here is where the issue is...it is not pasting the selected info here
xlSheet.Activate
    Range("A3").Activate

EditCopy    'happens in Project
    'EditPaste
xlSheet.Paste    'happens in Excel

此外，您可以在粘贴后将标题添加到Excel。这两个步骤不依赖。