VBAを使用してExcelシートにチャートを配置するにはどうすればよいですか？

Question

Excelのワークブックに大きなデータセットが配置されています。各データセットはR4、C192を含み、各シートは10セットのデータを含む。このコードでは、データセットごとに1つずつ、10個のチャートが作成されます。私がチャートを作成したら、それらは別のチャートの上に重ねられます。私はそれらを論理的に配置されるように動かす必要があります。

これは何千回も必要な作業です。私は不安定な結果で以前の解決策を取りました。

What I want What I have

Sub CreateCharts() 


'This is where my variable names are stored, for titles. 
Sheets("names").Select 
Trial = "motor_pre" 
'loop interates through subject names (k loop) 
For k = 2 To 19 
subj = Worksheets("names").Cells(k, 1).Text 
If subj = "end" Then End 

x = 1 
'innerloop iterates through regions (j loop) 
For j = 2 To 11 
' m = j - 1 

Sheets("names").Activate 
    Reg = Worksheets("names").Cells(j, 3).Text 
    start_data = Worksheets("names").Cells(j, 8) 
    end_data = Worksheets("names").Cells(j, 9) 
Sheets(subj).Select 

ActiveSheet.Shapes.AddChart2(227, xlLine).Select 

ActiveChart.SetSourceData Source:=Range("'" & subj & "'!" & start_data _ 
& "$4:" & end_data & "$153") 

ActiveChart.FullSeriesCollection(1).XValues = "='" & subj & _  
"'!$H$4:$H$153" 
ActiveChart.ChartTitle.Text = subj & " " & Reg 
ActiveChart.Legend.Delete 


Next j 

Next k 
End Sub 

Answer 1

あなたは進む一方で、適切な場所でチャートを配置することができます。しかし、あなたのルーチンは正しく動作しているので、私はそれに触れません。後でこのマクロを起動して再構成してください。

Sub ReorganizeCharts() 
    Dim cht As ChartObject, left As Long, top As Long 

    ' Modify these parameters to your linking 
    Dim chtWidth As Long, chtHeight As Long, chartsPerRow As Long 
    chtWidth = 200: chtHeight = 200: chartsPerRow = 4 

    Application.ScreenUpdating = False: Application.EnableEvents = False 
    On Error GoTo Cleanup 
    For Each cht In Sheets("names").ChartObjects 
     'adjust coordinates for next chart object 
     With cht 
      .top = top: .left = left: .Width = chtWidth: .Height = chtHeight 
     End With 

     left = left + chtWidth 
     If left > chartsPerRow * chtWidth * 0.99 Then 
      left = 0 
      top = top + chtHeight 
     End If 
    Next 
Cleanup: 
    Application.ScreenUpdating = True: Application.EnableEvents = True 
End Sub