VBA 복사 프로젝트에서 Excel로 데이터 붙여 넣기

Question

아래 코드를 실행하고 가짜 결과를 얻습니다.

어떤 이유로 MS 프로젝트 데이터 대신 원하는 코드에 5 줄의 코드를 복사합니다.

누구나 초보자를 도와 줄 수 있습니까? 코드의

다섯 줄은 잘못 Excel 워크 시트에 복사 :

'Open MS Project file 
projApp.Application.FileOpenEx "C:File.mpp" 

Set projApp = projApp.ActiveProject 

'Final set up of code 
Set projApp = Nothing 

Sub OpenProjectCopyPasteData() 

Dim appProj As MSProject.Application 
Dim aProg As MSProject.Project 
Dim sel As MSProject.Selection 
Dim ts As Tasks 
Dim t As Task 
Dim rng As Range 
Dim ws As Worksheet 

Application.DisplayAlerts = False 

'Clear current contents 

Set ws = Worksheets("Project Data") 
Set rng = ws.Range("A:J") 
rng.ClearContents 

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

'Open MS Project file 
projApp.Application.FileOpenEx "C:File.mpp" 
Set projApp = projApp.ActiveProject 

'Final set up of code 
Set projApp = Nothing 

appProj.Visible = True 

WindowActivate WindowName:=aProg 

'Copy the project columns and paste into Excel 
Set ts = aProg.Tasks 

SelectTaskColumn Column:="Task Name" 
OutlineShowAllTasks 
OutlineShowAllTasks 
EditCopy 
Set ws = Worksheets("Project Data") 
Set rng = ws.Range("A:A") 
ActiveSheet.Paste Destination:=rng 

SelectTaskColumn Column:="Task Name" 
EditCopy 
Set rng = ws.Range("B:B") 
ActiveSheet.Paste Destination:=rng 

SelectTaskColumn Column:="Resource Names" 
EditCopy 
Set rng = ws.Range("C:C") 
ActiveSheet.Paste Destination:=rng 

SelectTaskColumn Column:="Finish" 
EditCopy 
Set rng = ws.Range("D:D") 
ActiveSheet.Paste Destination:=rng 

Application.DisplayAlerts = True 
appProj.DisplayAlerts = True 

End Sub 

Answer 1

원래 코드는 위의 일을 어떻게, 확실하지 않다 당신 Dim 및 변수 appProjSet하지만 이후 나중에 projApp.Application.FileOpenEx "C:File.mpp" (projApp <>appProj)으로 MS-Project 파일을 열려고합니다. "C A"

은 열에서 "프로젝트 데이터"를 워크 시트에 3 열 ( "Name", "Resource Names" 및 "Finish")를 복사합니다 아래 (테스트) 코드를 사용해보십시오.

코드

Option Explicit 

Sub OpenProjectCopyPasteData() 

Dim PrjApp  As MSProject.Application 
Dim aProg  As MSProject.Project 
Dim PrjFullName As String 
Dim t   As Task 
Dim rng   As Range 
Dim ws   As Worksheet 

Application.ScreenUpdating = False 
Application.DisplayAlerts = False 

'Clear current contents 
Set ws = Worksheets("Project Data") 
Set rng = ws.Range("A:J") 
rng.ClearContents 

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

'Open MS Project file 
PrjFullName = "C:File.mpp" '<-- keep the MS-Project file name and path in a variable 
PrjApp.Application.FileOpenEx PrjFullName 
Set aProg = PrjApp.ActiveProject 

' show all tasks 
OutlineShowAllTasks 

'Copy the project columns and paste into Excel 
SelectTaskColumn Column:="Name" 
EditCopy 
Set ws = Worksheets("Project Data") 
Set rng = ws.Range("A:A") 
rng.PasteSpecial xlPasteValues 
rng.PasteSpecial xlPasteFormats 

SelectTaskColumn Column:="Resource Names" 
EditCopy 
Set rng = ws.Range("B:B") 
rng.PasteSpecial xlPasteValues 
rng.PasteSpecial xlPasteFormats 

SelectTaskColumn Column:="Finish" 
EditCopy 
Set rng = ws.Range("C:C") 
rng.PasteSpecial xlPasteValues 
rng.PasteSpecial xlPasteFormats 

' reset settings of Excel and MS-Project 
Application.DisplayAlerts = True 
Application.ScreenUpdating = True 
PrjApp.ScreenUpdating = True 
PrjApp.DisplayAlerts = True 

'PrjApp.FileClose False 
PrjApp.Quit pjDoNotSave 
Set PrjApp = Nothing 

End Sub