我正在尝试做两件事 (a) 在 MS Project 中打开一个新文件(成功),然后将 excel (A2:A10000) 中的列中的信息转录到 MSProject 中名为“名称”的列中,这是任务名称的对象(我相信)。我将进行其他转录(例如 B2:B10000 到项目中的“开始”或开始日期,但该代码将遵循与下面相同的逻辑 - 所以一旦我转录此列,我将为另一个编写代码列(顺便说一句,现在所有列的代码都相似,它们都跳过该命令而不更新 MSProject)。
'open a new project file in MSProject
Set pjapp = CreateObject("MSProject.Application")
If pjapp Is Nothing Then
MsgBox "Project is not installed"
Exit Sub
End If
pjapp.Visible = True
Set newproj = pjapp.Projects.Add
newproj.Title = "ExcelExtract"
'Copy and paste from excel to MSProject
Dim wst As Worksheet
Set wst = ThisWorkbook.Worksheets("Project_Outline")
Dim tsk As Task 'NOTE: I have turned on Microsoft Project Reference Library. In VBA Excel -> Tools -> (checkbox) "References MS Office Project"
Set wsOuts = wb.Sheets("Project_Outline")
Set wsTaskList = wsOuts.Range("A2:A10000")
For Each tsk In ActiveProject.Tasks
If Not tsk Is Nothing Then 'ERROR: this code gets skipped over and is never seen
tsk.Name = tsk.wsTaskList
End If
Next tsk
lyonsguy,看看这个宏并根据需要修改以满足您的需求。
'Macro written by John - Project
'Version 1.0 9/25/15 11:00 AM
Option Explicit
Option Compare Text
Public Const ver = " - 1.0"
Public Xl As Excel.Application
Public WB As Excel.Workbook
Public s As Excel.Worksheet
Public c As Excel.Range
Public Tsks As Tasks
Public UID As Single
Public SeedDt As Date
Public DurVal As Single, HPD As Single, HPW As Single, cf As Single
Public numrows As Integer, i As Integer, p1 As Integer
Public curcel As Variant 'could be either a number or text
Sub ImportExcelDataToProject()
MsgBox "This macro imports the following data fields from Excel:" & vbCr & _
" Task Name" & vbCr & " Outline Level" & vbCr & _
" Duration" & vbCr & " Start (if necessary)" & vbCr & _
" Predecessors" & vbCr & " Resource Names" & vbCr & _
" Task Notes", vbInformation, "Import from Excel" & ver
'Open the Excel workbook to gather data
' Note: Excel need not be running
Set WB = Workbooks.Open(FileName:="C:\Users\John\Desktop\ExcelToProjectVBAImportX.xlsx")
Set s = WB.Worksheets(1)
'Create new Project file to receive imported data
FileNew
'----------------------
'Gather some basic parameters from Excel and Project
' Find earliest start date used in Excel workbook
sort1
' Find out how many rows of data in Excel worksheet
' (assumes first row is header, if there is none remove the "-1")
numrows = WB.Worksheets(1).UsedRange.Rows.Count - 1
' Find the default hours per day and hours per week settings for Project
HPD = ActiveProject.HoursPerDay
HPW = ActiveProject.HoursPerWeek
'-----------------------
'Read each row of data from the worksheet and create tasks in Project
Application.Caption = "Progress"
ActiveWindow.Caption = " Reading worksheet and exporting"
Set c = s.Range("B2") 'set reference to first column of data to be imported
Set Tsks = ActiveProject.Tasks
For i = 0 To numrows - 1
Tsks.Add.Name = c.offset(i, 0).Value
'find the unique ID of the task just added
' since tasks are added in sequence, the count property identifies the current task
' (having the Unique ID facilitates expansion of the macro for increased functionality)
UID = Tsks(Tsks.Count).UniqueID
Tsks.UniqueID(UID).OutlineLevel = c.offset(i, 1).Value
'skip remaining columns for this row if this is destined to be a summary line in Project
' (Project calculates duration and start and best practices dictate no resources assigned)
If c.offset(i, 2).Value <> "" Then
'resolve units used in duration column of Excel worksheet
DecodeXLDurUnits
Tsks.UniqueID(UID).Duration = DurVal
Tsks.UniqueID(UID).Predecessors = c.offset(i, 3).Value
'if no predecessors exist for this task AND it starts after the Project Start Date
' then set start date. Note: this will set a start-no-earlier-than (SNET) constraint
If Tsks.UniqueID(UID).Predecessors = "" And CStr(c.offset(i, 4).Value) > SeedDt Then
Tsks.UniqueID(UID).Start = CStr(c.offset(i, 4).Value)
End If
Tsks.UniqueID(UID).ResourceNames = c.offset(i, 5).Value
End If
Tsks.UniqueID(UID).Notes = c.offset(i, 6).Value
Next i
'------------------------
'Finally, close and exit
MsgBox "Data Import is complete", vbOKOnly, "Import from Excel"
Application.Caption = ""
ActiveWindow.Caption = ""
WB.Close savechanges:=False
End Sub
'This routine determines if duration column in Excel is in minutes, hours, days or weeks
' (most likely units) and then adjusts the data accordingly for import to Project
Sub DecodeXLDurUnits()
curcel = c.offset(i, 2).Value
'default if duration column is in minutes
p1 = Len(CStr(curcel)) + 1
cf = 1
If InStr(curcel, "h") > 0 Then
p1 = InStr(curcel, "h")
cf = 60
ElseIf InStr(curcel, "d") > 0 Then
p1 = InStr(curcel, "d")
cf = HPD * 60
ElseIf InStr(curcel, "w") > 0 Then
p1 = InStr(curcel, "w")
cf = HPW * 60
End If
'convert duration value to be in minutes for Project import
DurVal = CSng(Mid(curcel, 1, p1 - 1)) * cf
End Sub
'This routine examines the pre-formatted Excel Workbook Start column and finds the
' earliest date. This is then used to set the Project Start Date
Sub sort1()
Dim Cnt As Integer
numrows = s.UsedRange.Rows.Count
SeedDt = "12/31/2049" 'maintain compatibility with Pre-Project 2013 versions
Set c = s.Range("F2")
For i = 0 To numrows - 1
If c.offset(i, 0).Value <> "" And c.offset(i, 0).Value < SeedDt Then SeedDt = c.offset(i, 0).Value
Next i
ActiveProject.ProjectStart = SeedDt
End Sub