问题
Situation: Our company has an Open Issues list we use for individual parts during trialing/launching a program. The program has its own Excel document, and each part has its own tab in that document for a running list of that specific part. It has recently been proposed that we track how long issues are open using MS Project. I can take the information from our Excel tab and manually copy it into Project to show what we want, and I can have Project automatically update linked sources if it is 1:1 Excel sheet to Project sheet, but we only need 1 Project sheet at a time, and they need to update based on the open tab of the workbook, so the reference changes based on what part we're looking at.
Goal: I am looking for macro code for either/both Excel and Project that can run based on a single click that will take the reference cells in Excel copy over to Project.
So the users will open Excel and go to the tab of the part they want a chart of in Project. They will then be able to click a button in that tab that 1) opens the formatted Project file 2) selects specific cells on that Excel tab to copy over to Project [for example, in Excel lines BE60:BI60 will copy over into line 1 of Project, BE67:BI67 to line 2, so on]. I can get the macro to open Project easily enough from Excel, but am struggling on where to even begin on copying the link source based on current tab.
The solved code I've went with is below:
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
回答1:
Here is code that opens the MS Project file from Excel and updates the schedule from the active tab in the Excel file.
The trick is to use the Find method of the Project Application object to find the task, then set a Task object variable to make updating the fields simple. Don't bother updating the Duration field as that will be calculated based on the Start and Finish.
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
来源:https://stackoverflow.com/questions/60552888/how-can-i-make-a-macro-in-excel-workbook-tab-to-open-ms-project-and-copy-referen