VBAコピーをプロジェクトからExcelにデータをコピーする

Question

私は以下のコードを実行して偽の結果を得ています。

何らかの理由で、指定されたMSプロジェクトデータではなく、5行のコードを目的のワークシートにコピーします。

誰でも初心者を助けることができますか？間違ってExcelワークシートにコピーしたコードの

5系統：

'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とSet変数appProjいるので、あなたの元のコードは、上記の働いていたかどうかはわかりませんけど、後で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