複数のエクセルファイルのシートの結合とシート毎のデータからのグラフの作成

Question

前提・実現したいこと

VBAでディレクトリ内のエクセルファイルを結合して複数のシートを含んだ新規のブックを作成するコードとそのシート一枚一枚でシートのデータを元にグラフを作成するコードの統合を目指しています。後者のコードは以前ご回答いただいたものを改良したものです。
それぞれのコードは別々なら作用するのですが、合わせるとうまくいきません。

発生している問題

エクセルの統合を目指しているコードは新規のブックを作成し、そのブックに他のエクセルのシートをコピーして結合するものなのですが、その後のグラフを作成がマクロを実行したエクセル上で行われてしまっています。

これが変数の定義ミスが原因であることはわかるのですが、どこが間違っているのかがわかりません。

また統合に伴い、グラフの作成にも問題が起こっています。これも単体なら動くので、変数の定義ミスが原因であるとは思うのですがどこが間違っているのかわかりません。

うまくってるグラフの作成図(上)

うまく行ってないグラフの作成図(上)

該当のソースコード

Sub データまとめ1()

    MsgBox "まとめたいエクセルブックのフォルダを選択して、" & vbCrLf & _
           "「OK」をクリックして下さい。"
    
    '画面表示OFF
    Application.ScreenUpdating = False
 
    '-------------------------------------------
    ' 変数定義
    '-------------------------------------------
    Const cnsDIR = "*.xls*"                '対象フォルダ内エクセルファイル検索用
    Dim FilePath As String                  'ファイルパス
    Dim strFileName As String               '結合元ファイル名
     
    Dim i As Integer                        'ループ用
     
    'シート結合エクセル用オブジェクト
    Dim App As Excel.Application
    Dim Book As Workbook
    Dim Sheet As Worksheet
    'シート結合エクセル保存名
    Dim BookName As String
     
    '結合元エクセル用
    Dim Book2 As Workbook
    Dim Sheet2 As Worksheet
    
     
    '-------------------------------------------
    ' シート結合後のファイル名の指定
    '-------------------------------------------
    BookName = Format(Now(), "yyyymmdd") & "データまとめファイル.xlsx"
     
    '-------------------------------------------
    ' 結合元のフォルダ選択
    '-------------------------------------------
    FilePath = FolderSelect()
     
    'キャンセル時
    If FilePath = "" Then
        MsgBox "キャンセルされました。処理を終了します。"
        End
    End If
     
    '-------------------------------------------
    ' 結合先ワークブック作成
    '-------------------------------------------
    'オブジェクトセット
    Set App = CreateObject("Excel.Application")
    '非表示
    App.Visible = False
    'エクセル新規オープン
    Set Book = App.Workbooks.Add
     
    '-------------------------------------------
    ' 結合先ワークブックにコピー
    '-------------------------------------------
    ' 先頭のファイル名の取得
    strFileName = Dir(FilePath & cnsDIR, vbNormal)
     
    ' ファイルが見つからなくなるまで繰り返す
    Do While strFileName <> ""
     
        '対象フォルダ配下のエクセルオープン
        Set Book2 = App.Workbooks.Open(Filename:=FilePath & "\" & strFileName)
        
        '開いたコピー元のエクセルのシート分繰り返す
        For i = 1 To Book2.Worksheets.Count
        
            Book2.Worksheets(i).Visible = True
        
            '結合用のブックにシートコピー
            Book2.Worksheets(i).Copy after:=Book.Worksheets(i)
            'シート名を「元のシート名」に変更
            Book.ActiveSheet.Name = Book2.Worksheets(i).Name
            
         
        Next i
         
        'コピー元のエクセルを保存せずに閉じる
        Book2.Close (False)
        ' 次のファイル名を取得
        strFileName = Dir()
         
    Loop
    
    'シート「Sheet1」を削除
    Book.Worksheets("Sheet1").Delete
    '名前を付けて保存
    Book.SaveAs Filename:=FilePath & "\" & BookName
    
    '-------------------------------------------
    ' 結合後のシートでのグラフ作成(ここから次まで統合したいコード)
    '-------------------------------------------
    
    
    '結合したエクセルのシート分繰り返す
    For i = 1 To Book.Worksheets.Count
    'rawデータの処理
        Book.Worksheets(i).Activate
        Range("A1025:B1025").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Cut
        Range("C1").Select
        ActiveSheet.Paste
        Range("E1").Select
        ActiveCell.FormulaR1C1 = "=MAX(R[29]C[-3]:R[1023]C[-3])"
        Range("F1").Select
        ActiveCell.FormulaR1C1 = "=MAX(R[29]C[-2]:R[1023]C[-2])"
        Range("F2").Select
     'グラフの作成
            With ActiveSheet.Shapes.AddChart
                .Top = 40
                .Left = 400
                .Name = "上"
                    With .Chart
                        .ChartType = xlXYScatter
                        .SetSourceData Source:=Worksheets(i).Range("$A$1:$B$1024")
                        .HasTitle = True
                        .ChartTitle.Text = "上"
                    End With
            End With
            
            With ActiveSheet.Shapes.AddChart
                .Top = 300
                .Left = 400
                .Name = "横"
                    With .Chart
                        .ChartType = xlXYScatter
                        .SetSourceData Source:=Worksheets(i).Range("$C$1:$D$1024")
                        .HasTitle = True
                        .ChartTitle.Text = "横"
                    End With
            End With
        
    Next i
     
    '-------------------------------------------
    ' エクセルの終了
    '-------------------------------------------
    'エクセルを閉じる
    Book.Close (False)
 
    '-------------------------------------------
    ' 終了処理
    '-------------------------------------------
    Set Sheet2 = Nothing
    Set Book2 = Nothing
 
    Set Sheet = Nothing
    Set Book = Nothing
    Set App = Nothing
    
    MsgBox "処理を完了します。"
 
    '画面表示ON
    Application.ScreenUpdating = True
    End
   

    '画面表示ON
    Application.DisplayAlerts = True
    End
 
End Sub
 
'#############################################################################
' フォルダ参照用
'#############################################################################
Function FolderSelect() As String
 
    '-------------------------------------------
    ' 変数定義
    '-------------------------------------------
    Dim objFileDialog As Object             'FileDialog
    Dim strTitle As String                  'タイトル
    Dim strPath As String                   'フォルダパス
    Dim strInitialPath As String            '初期フォルダパス
     
    '-------------------------------------------
    ' フォルダ選択ダイアログの初期設定
    '-------------------------------------------
    'ダイアログタイトル
    strTitle = "結合元のフォルダを選択してください"
    'ダイアログの初期パスをモジュール起動エクセルに設定
    strInitialPath = ActiveWorkbook.Path
     
    '-------------------------------------------
    ' フォルダ選択ダイアログ表示
    '-------------------------------------------
    Set objFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
         
    With objFileDialog
        'タイトル
        .Title = strTitle
        '初期フォルダパス
        .InitialFileName = strInitialPath
         
        If .Show = False Then
            'キャンセル時
            GoTo Exit_Function
        Else
            'フォルダパス取得
            strPath = .SelectedItems(1)
        End If
     
    End With
     
    '-------------------------------------------
    ' 終了処理
    '-------------------------------------------
Exit_Function:
    Set objFileDialog = Nothing
     
    FolderSelect = strPath
 
End Function

補足情報

windows10
Excel 2019
を使用しています。

Answer 1

Activesheet を App.Activesheet とするか、

Dim ws As Worksheet
Set ws = Book.Worksheets(i)
として、以降の Activesheet を ws にすると解決しそうな気がします。

Comments

[ikene]

回答ありがとうございました。残念ながら前者と後者どちらも試しましたがうまく動きませんでした。

シートをすべて結合するファイルは生成が行われていたので、グラフを作成するコード(コード上でここから次までと記載されている箇所)で上記の回答の操作を行いました。状況としては変わらず、作成した結合するエクセルブック中でグラフ作成は行われず、マクロを実行したエクセル上でグラフ作成が行われてしまっています。また新たに判明したこととしてグラフのデータのペーストが行われず、切り取った状態で止まってしまっているようです。
次に行った後者のコード(修正箇所のみ)を添付します。もし修正に間違いがあれば訂正を頂けると非常に助かります。
Dim ws As Worksheet
Set ws = Book.Worksheets(i)

'結合したエクセルのシート分繰り返す
For i = 1 To Book.Worksheets.Count
'rawデータの処理
ws.Activate
Range("A1025:B1025").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Cut
Range("C1").Select
ws.Paste
Range("E1").Select
ActiveCell.FormulaR1C1 = "=MAX(R[29]C[-3]:R[1023]C[-3])"
Range("F1").Select
ActiveCell.FormulaR1C1 = "=MAX(R[29]C[-2]:R[1023]C[-2])"
Range("F2").Select
'グラフの作成
With ws.Shapes.AddChart
.Top = 40
.Left = 400
.Name = "上"
With .Chart
.ChartType = xlXYScatter
.SetSourceData Source:=ws.Range("$A$1:$B$1024")
.HasTitle = True
.ChartTitle.Text = "上"
End With
End With

With ws.Shapes.AddChart
.Top = 300
.Left = 400
.Name = "横"
With .Chart
.ChartType = xlXYScatter
.SetSourceData Source:=ws.Range("$C$1:$D$1024")
.HasTitle = True
.ChartTitle.Text = "横"
End With
End With

Next i

[jinoji]

今回のコードは、Excel.Applicationが二つ並行して動いているのがそもそもの不具合のもとです。
本当にそうする必要があるかは考えてみた方がいいと思いますが、
さし当たり、上掲の部分だと、Range とかSelectionとかActiveCellとかが、そうじゃない方の（マクロ側の）Appで動いているのが原因だと思います。
ws.Range App.Selection App.ActiveCellとかにすれば改善されると思いますが、他にも同様の箇所がないか見た方がいいかも。

[ikene]

ご返信ありがとうございます。後半でご指摘いただいた修正をしましたが、残念ながら正常にグラフが作成されることはありませんでした。

まず大変初歩的な質問で申し訳ないですが、エクセルが二つ並行しているのを避けるためには、マクロを実行しているファイル上でシートをまとめなくてはならないということでしょうか？

とりあえず、間に合わせの処理として、修正を行った後の状況としてはシートをまとめた新規ブックは作成されるものの、データの処理もグラフも作製されないというものです。今度はマクロを実行したファイル上では何も作成されていないことから、マクロ側でのAppでグラフ作製のコードが動くのは避けることができたのではと思います。しかしグラフ作成がシートをまとめたファイル上でも行われておらず、現在のコードのwsはどこのシートを指定していることになっているのか見当がつきません。
次に再度修正したコード(同様の箇所がなさそうなので修正箇所のみ)を添付いたします。何度もお手数をおかけしますが問題点があれば指摘いただければたすかります。
Dim ws As Worksheet
Set ws = Book.Worksheets(i)

'結合したエクセルのシート分繰り返す
For i = 1 To Book.Worksheets.Count
'rawデータの処理
ws.Activate
ws.Range("A1025:B2048").Select
App.Selection.Cut
ws.Range("C1").Select
ws.Paste
ws.Range("E1").Select
App.ActiveCell.FormulaR1C1 = "=MAX(R[29]C[-3]:R[1023]C[-3])"
ws.Range("F1").Select
App.ActiveCell.FormulaR1C1 = "=MAX(R[29]C[-2]:R[1023]C[-2])"
'グラフの作成
ws.Range("$A$1:$B$1024").Select
With ws.Shapes.AddChart
.Top = 40
.Left = 400
.Name = "上"
With .Chart
.ChartType = xlXYScatter
.SetSourceData Source:=ws.Range("$A$1:$B$1024")
.HasTitle = True
.ChartTitle.Text = "上"
End With
End With

ws.Range("$C$1:$D$1024").Select
With ws.Shapes.AddChart
.Top = 300
.Left = 400
.Name = "横"
With .Chart
.ChartType = xlXYScatter
.SetSourceData Source:=ws.Range("$C$1:$D$1024")
.HasTitle = True
.ChartTitle.Text = "横"
End With
End With

Next i

[jinoji]

なんかすみません。
前半が終わったら一度Bookを閉じて後半で開きなおすとかどうでしょう。

Book.SaveAs Filename:=FilePath & "\" & BookName
'前半ここまで

Book.Close
App.Quit

Set Book =Worksheets.Open(FilePath & "\" & BookName)

'後半ここから
For i = 1 To Book.Worksheets.Count

[ikene]

返信ありがとうございます。
後にsaveだけ挟んで、完全解決しました。
その解決法がシンプルでいいですね。
ありがとうございました。