如何自动使 Excel 单元格等于 Project 单元格？

Question

我有 2 个文档，一个 Excel 文档和一个 Microsoft Project 文档。我想在 Excel 文档中添加一个“更新”按钮，使某些单元格等于项目文件中的某些单元格。

在某种程度上，我试图做与这个问题相反的事情：How can I make a macro in Excel workbook tab to open MS Project and copy reference cells

这是我目前拥有的按钮宏： （在此示例中，项目文件中的任务/列之一是“ID”，并且我试图使单元格（4,7）等于的所需值存在于项目中同一 ID 行的另一列上文件。无法弄清楚如何执行此操作。）

Sub Update()

projApp As MSProject.Application

Set ProjApp = GetObject(, "MSProject.Application")

projApp.Visible = False

projApp.FileOpenEx "C:\files\project.mpp"

ActiveWorkbook.Worksheets("Inputs").Cells(4,7) = projApp.Find Field:= "ID", Test:="equals", Value:="5748"

End Sub

Answer 1

此代码将打开一个项目文件，按 ID 搜索任务，然后将数据从该任务传输到 Excel 文件。这里重要的是 Find 方法返回 True/False 而不是对找到的任务的引用。

Sub Update()

Dim projApp As MSProject.Application
Dim iOpened As Boolean

On Error Resume Next
Set projApp = GetObject(, "MSProject.Application")
If projApp Is Nothing Then
    Set projApp = CreateObject("MSProject.Application")
    iOpened = True
End If
projApp.Visible = True

projApp.FileOpenEx "C:\files\project.mpp"


If projApp.Find(Field:="ID", Test:="equals", Value:="5748") Then

    Dim t As MSProject.Task
    Set t = projApp.ActiveCell.Task
    ActiveWorkbook.Worksheets("Inputs").Cells(4, 7) = t.Finish
    
End If

projApp.FileCloseEx pjDoNotSave
If iOpened Then
    projApp.Quit pjDoNotSave
End If

End Sub

注意事项：

• 此代码不依赖于 Project 应用程序是否已打开（GetObject 与 CreateObject）。
• 在代码完美运行之前，最好确保自动化应用程序是可见的（在本例中为 Project）。