Excel VBA - MS 프로젝트 헤더를 사용하여 열 이름 만들기

Question

MS 프로젝트 파일의 데이터로 Excel 스프레드 시트를 채우는 스크립트를 작성하는 중입니다. 다른 이름을 가진 여러 개의 사용자 지정 열이있는 경우 (사용자 지정 숫자 필드가 다른 이름으로 채워짐) MS 프로젝트 열의 제목 이름을 인식하도록 스크립트를 원합니다.

아래 코드는 내 시도이지만, 작업 열 제목의 값을 시트에 기록 할 때 오류가 발생합니다. 여기서 제가 잘못된 것이 있습니까?

Sub PopulateSheet() 
Dim Proj    As MSProject.Application 
Dim NewProj   As MSProject.Project 
Dim t    As MSProject.Task   

Dim xl as workbook 
Dim s as worksheet 
Dim Newsheet as worksheet 

Set Xl = ThisWorkbook 
BookNam = Xl.Name 
Set Newsheet = Xl.Worksheets.Add 

'Code to find and open project files 
Set Proj = New MSProject.Application 
MsgBox ("Please Select MS Project File for Quality Checking") 

'Select Project File 
FileOpenType = Application.GetOpenFilename(_ 
       FileFilter:="MS Project Files (*.mpp), *.mpp", _ 
       Title:="Select MS Project file", _ 
       MultiSelect:=False) 

'Detect if File is selected, if not then stop code 
If FileOpenType = False Then 
    MsgBox ("You Havent Selected a File") 
    Exit Sub 
End If 

'Write the FileOpenType variant to two separate strings 
NewProjFilePath = Left$(FileOpenType, InStrRev(FileOpenType, "\")) 
NewProjFileName = Mid$(FileOpenType, InStrRev(FileOpenType, "\") + 1)  

Newsheet.Name = NewProjFileName 
Set s = Newsheet 

'Populate spreadsheet header row with column titles from MS Project 
s.Range("A1").Value = t.Number1 ***<-- Error '91' - Object variable or With block variable not set*** 

End Sub 

Answer 1

활성 작업 테이블의 필드를 통해 루프 테이블에 표시되는 필드 제목을 출력 일반적인 코드 .

Sub GetTaskTableHeaders() 

    Dim t As Table 
    Set t = ActiveProject.TaskTables(ActiveProject.CurrentTable) 
    Dim f As TableField 
    For Each f In t.TableFields 
     If f.Field > 0 Then 
      Dim header As String 
      Dim custom As String 
      custom = Application.CustomFieldGetName(f.Field) 
      If Len(f.Title) > 0 Then 
       header = f.Title 
      ElseIf Len(custom) > 0 Then 
       header = custom 
      Else 
       header = Application.FieldConstantToFieldName(f.Field) 
      End If 
      Debug.Print "Field " & f.Index, header 
     End If 
    Next f 

End Sub 

필드는 프로젝트 레벨에서 다른 제목을 부여하도록 사용자 정의하거나 테이블 레벨에서 사용자 정의 할 수 있습니다. 이 코드는 두 가지 사용자 정의를 모두 찾지 만 둘 다 발견되지 않으면 필드 이름이 사용됩니다.

Answer 2

코드의 주석 내부에 아래의 코드를 설명하십시오 : 여기

Option Explicit 

Sub PopulateSheet() 

Dim Proj    As MSProject.Application 
Dim NewProj    As MSProject.Project 
Dim PjTableField  As MSProject.TableField ' New Object 
Dim PjTaskTable   As MSProject.Table ' New Object 
Dim t     As MSProject.task 

Dim xl As Workbook 
Dim s As Worksheet 
Dim Newsheet As Worksheet 
Dim BookName As String 
Dim FileOpenType 
Dim NewProjFilePath As String, NewProjFileName As String 

Set xl = ThisWorkbook 
BookName = xl.Name 
Set Newsheet = xl.Worksheets.Add 

'Code to find and open project files 
Set Proj = New MSProject.Application 
MsgBox ("Please Select MS Project File for Quality Checking") 

'Select Project File 
FileOpenType = Application.GetOpenFilename(_ 
       FileFilter:="MS Project Files (*.mpp), *.mpp", _ 
       Title:="Select MS Project file", _ 
       MultiSelect:=False) 

'Detect if File is selected, if not then stop code 
If FileOpenType = False Then 
    MsgBox ("You Havent Selected a File") 
    Exit Sub 
End If 

'Write the FileOpenType variant to two separate strings 
NewProjFilePath = Left$(FileOpenType, InStrRev(FileOpenType, "\")) 
NewProjFileName = Mid$(FileOpenType, InStrRev(FileOpenType, "\") + 1) 

Newsheet.Name = NewProjFileName 
Set s = Newsheet 

' Open MS-Project File 
Proj.FileOpen NewProjFilePath & NewProjFileName 
Set NewProj = Proj.ActiveProject 


' ===== New code Section ===== 

' set the Table object 
Set PjTaskTable = NewProj.TaskTables(NewProj.CurrentTable) 

' loop through all tablefields in table 
For Each PjTableField In PjTaskTable.TableFields 
    If PjTableField.Field = pjTaskNumber1 Then ' check if currect field numeric value equals the numeric value of "Number1" 
     'Populate spreadsheet header row with column titles from MS Project 
     s.Range("A1").Value = PjTableField.Title ' populate "A1" with the field's title and 
    End If 
Next PjTableField 

End Sub