VBA複数のExcelファイルからの複数の図表を1つの単語の文書にコピー

Question

長時間のlurkerはここにあります。 複数のExcelファイルから約350の図表を1つの文書にコピーしようとしています。 私は専門家はいないが、これまでのところ、私は特定のExcelファイルを開いて、その文書をWord文書にコピーすることができました。

Sub copy_pic_excel() 
Dim xlsobj_2 As Object 
Dim xlsfile_chart As Object 
Dim chart As Object 

Set xlsobj_2 = CreateObject("Excel.Application") 
xlsobj_2.Application.Visible = False 
Set xlsfile_chart = xlsobj_2.Application.Workbooks.Open("C:\Users\Kiel\Desktop\chart.xls") 

Set chart = xlsfile_chart.Charts("chart1") 
chart.Select 
chart.ChartArea.Copy 
With Selection 
    .PasteSpecial Link:=False, DataType:=wdPasteEnhancedMetafile, _ 
     Placement:=wdInLine, DisplayAsIcon:=False 
End With 

Set chart = xlsfile_chart.Charts("chart2") 
chart.Select 
chart.ChartArea.Copy 
With Selection 
    .PasteSpecial Link:=False, DataType:=wdPasteEnhancedMetafile, _ 
     Placement:=wdInLine, DisplayAsIcon:=False 
End With 

Set chart = xlsfile_chart.Charts("chart3") 
chart.Select 
chart.ChartArea.Copy 
With Selection 
    .PasteSpecial Link:=False, DataType:=wdPasteEnhancedMetafile, _ 
     Placement:=wdInLine, DisplayAsIcon:=False 
End With 

Set chart = xlsfile_chart.Charts("chart4") 
chart.Select 
chart.ChartArea.Copy 
With Selection 
    .PasteSpecial Link:=False, DataType:=wdPasteEnhancedMetafile, _ 
     Placement:=wdInLine, DisplayAsIcon:=False 
End With 

Set chart = xlsfile_chart.Charts("chart5") 
chart.Select 
chart.ChartArea.Copy 
With Selection 
    .PasteSpecial Link:=False, DataType:=wdPasteEnhancedMetafile, _ 
     Placement:=wdInLine, DisplayAsIcon:=False 
End With 

Set chart = xlsfile_chart.Charts("chart6") 
chart.Select 
chart.ChartArea.Copy 
With Selection 
    .PasteSpecial Link:=False, DataType:=wdPasteEnhancedMetafile, _ 
     Placement:=wdInLine, DisplayAsIcon:=False 
End With 

Set chart = xlsfile_chart.Charts("chart7") 
chart.Select 
chart.ChartArea.Copy 
With Selection 
    .PasteSpecial Link:=False, DataType:=wdPasteEnhancedMetafile, _ 
     Placement:=wdInLine, DisplayAsIcon:=False 
End With 

'clean up 
Set xlsfile_chart = Nothing 
xlsobj_2.Quit 
Set xlsobj_2 = Nothing 
End Sub 

これは明らかに毎回大規模な混乱やエラーですが、それはちょうど約小規模なプロジェクトのために働きます。

すべての.xlsファイルのすべてのグラフのフォルダ全体からチャートをソースにすることを誰にも勧められますか？

Answer 1

フォルダ内のすべてのXLSファイルをステップ実行するには、DIRコマンドを使用する必要があります。以下はその使用例です。私は名前をセルに保存していますが、関数に渡すために名前を使うことができます。あなたは、あなたは

Sub Directory() 
Dim strPath As String 
Dim strFolderPath As String 
Dim strFileName As String 
Dim intRow As Integer 
Dim intColumn As Integer 

intRow = 1 
intColumn = 1 

strFolderPath = "h:\*.xls" 
strFileName = Dir(strFolderPath) 

Do 
    Sheets("Main").Cells(intRow, intColumn) = strFileName 'test output to sheet 
    Debug.Print strFileName 'test output to debug 
    strFileName = Dir 
    intRow = intRow + 1 
Loop Until strFileName = "" 
End Sub 

しかし、同じフォルダ内のコードとメインシートを保存する簡単なショートカットがあるしたいフォルダへのパス名への変更する必要があり、現在のパス名を取得するためにApplication.ActiveWorkbook.Pathを使用します。各ブック（コード付きのものを除く）を開いて、「チャートの各チャート用」ループを使用してブック内の各チャートをステップ実行します。

Dim myChart As Chart 

For Each myChart In <Workbookname>.Charts 
    Debug.Print myChart.Name 
    //or use the myChart object to pass to your code 
Next