如何使用VBA在Excel工作表上排列图表？

Question

I have a large sets of data arranged in an excel workbook. Each set of data contains R4,C192, and each sheet contains ten sets of data. This code creates ten charts, one for each data set. After I create the charts, they are stacked on on top of another. I need to move them around so that they are arranged logically.

This is a task I need to do thousands of times. I worked a previous solution with unstable outcomes.

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

You can place the charts at the right place while proceeding. But since your routine is working correctly, I won't touch it, just launch this macro afterwards to reorganize them.

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