如何在Excel工作簿选项卡中创建宏以打开MS Project并复制引用单元格

情况：我们公司有一份未解决的问题清单，我们在试验/启动项目期间使用该清单。程序有自己的Excel文档，每个零件在该文档中都有自己的选项卡，用于该特定零件的运行列表。最近有人建议我们使用MS Project跟踪问题的开放时间。我可以从Excel选项卡中获取信息并手动将其复制到Project中，以显示我们需要的内容，如果Excel工作表与项目工作表的比例为1:1，我可以让Project自动更新链接源，但我们一次只需要1个项目工作表，它们需要根据工作簿的“打开”选项卡进行更新，所以参考值会根据我们看到的部分而变化

目标：我正在寻找Excel和Project的宏代码，这些宏代码可以通过单击将Excel中的引用单元格复制到Project来运行

因此，用户将打开Excel并转到他们希望在项目中显示图表的零件的选项卡。然后，他们可以单击该选项卡中的按钮，1）打开格式化的项目文件2）选择Excel选项卡上的特定单元格以复制到项目中[例如，在Excel中，BE60:BI60将复制到项目的第1行，BE67:BI67复制到第2行，依此类推]。我可以很容易地从Excel中获取宏以打开项目，但我甚至还在为从何处开始基于当前选项卡复制链接源而苦苦挣扎

我使用的已解决代码如下：

    Sub UpdateProject()

    Dim projApp As MSProject.Application

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

    projApp.FileOpenEx "C:\[File Location]\[File Name].mpp"

    Dim wst As Worksheet
    Set wst = ActiveSheet
    Dim rng As Range
    Set rng = wst.Range("D60")
    Dim lRow As Long
    lRow = rng.Row

    Do While lRow >= 60 And rng.Column = 4 And IsDate(wst.Cells(lRow, 7).Value)

        Dim taskName As String
        taskName = wst.Cells(lRow, 57) ' column BE
        If Len(taskName) > 0 Then
            ' find task in project schedule
            projApp.Find Field:="Name", Test:="equals", Value:=taskName
            Dim t As MSProject.Task
            If projApp.ActiveCell = taskName Then
                Set t = projApp.ActiveCell.Task

            Else    ' did not find the task, so add it
                Set t = projApp.ActiveProject.Tasks.Add(taskName)
            End If
            t.Start = wst.Cells(lRow, 59).Value         ' column BG
            t.Finish = wst.Cells(lRow, 60).Value        ' column BH
            t.ResourceNames = wst.Cells(lRow, 61).Value ' column BI
        End If

        ' find next trial
        Set rng = wst.UsedRange.Find(What:="Trial Date", After:=rng, SearchOrder:=xlByRows, SearchDirection:=xlNext)
        lRow = rng.Row
    Loop

End Sub

---

下面是从Excel打开MS Project文件并从Excel文件中的“活动”选项卡更新计划的代码

诀窍是使用projectapplication对象的方法来查找任务，然后设置一个对象变量以简化字段的更新。不必费心更新字段，因为它将根据开始和结束进行计算

Sub UpdateProject()

    Dim projApp As MSProject.Application

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

    projApp.FileOpenEx "C:\[File Location]\[File Name].mpp"

    Dim wst As Worksheet
    Set wst = ActiveSheet
    Dim rng As Range
    Set rng = wst.Range("D60")
    Dim lRow As Long
    lRow = rng.Row

    Do While lRow >= 60 And rng.Column = 4 And IsDate(wst.Cells(lRow, 7).Value)

        Dim taskName As String
        taskName = wst.Cells(lRow, 57) ' column BE
        If Len(taskName) > 0 Then
            ' find task in project schedule
            projApp.Find Field:="Name", Test:="equals", Value:=taskName
            Dim t As MSProject.Task
            If projApp.ActiveCell = taskName Then
                Set t = projApp.ActiveCell.Task

            Else    ' did not find the task, so add it
                Set t = projApp.ActiveProject.Tasks.Add(taskName)
            End If
            t.Start = wst.Cells(lRow, 59).Value         ' column BG
            t.Finish = wst.Cells(lRow, 60).Value        ' column BH
            t.ResourceNames = wst.Cells(lRow, 61).Value ' column BI
        End If

        ' find next trial
        Set rng = wst.UsedRange.Find(What:="Trial Date", After:=rng, SearchOrder:=xlByRows, SearchDirection:=xlNext)
        lRow = rng.Row
    Loop

End Sub

---

谢谢你，我明天会试试这个，让你知道它是如何运行的。第一部分，通过projApp.FileOpenEx。之后的代码将运行，但什么也没有发生-项目工作表仍然为空。由于您的代码打开了一个现有文件，此代码旨在更新计划，因此假定任务已经存在。在运行宏之前，请确保在Excel文件的每个选项卡上都有与单元格BE60名称相同的任务。如果要添加不存在的任务，请使用

Else

子句——请参阅更新的代码。明白了！需要else语句，因为它必须用框中的任何文本覆盖。我删除了制表符循环，因为它只需要关注当前活动的制表符，并且必须在“If”语句之后进行冗余语句，以便在工作表上的特定范围内循环。它使代码看起来笨重，但由于我需要特定的范围，我不知道是否有更干净的方法来做。它只需要运行一次，所以在执行时额外运行代码不是问题，应该可以。我将编辑我的初始消息以显示代码。欢迎进一步改进。我删除了通过选项卡的循环，并在Excel文件中为选项卡上的范围添加了一个循环（例如，每7行从第60行开始）。还有其他方法可以循环浏览excel选项卡上的各个部分，但这应该可以帮助您开始。