使用 excel VBA 将 excel 列转录为 MSproject 列

问题描述 投票:0回答:1

我正在尝试做两件事 (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
excel vba ms-project
1个回答
0
投票

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
© www.soinside.com 2019 - 2024. All rights reserved.