如何自动使 Excel 个单元格等于项目单元格？

Question

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

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

这是我目前拥有的按钮宏：（在此示例中，项目文件中的 tasks/columns 之一是“ID”，我试图使 Cell (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 方法 returns 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

备注：

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

如何自动使 Excel 个单元格等于项目单元格？

How automatically make Excel cells equal to Project cells?

excel

vba

ms-project