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

Question

我在 Excel 工作簿中排列了大量数据。每组数据包含R4，C192，每张表包含十组数据。此代码创建十个图表，每个数据集一个。在我创建图表后，它们被堆叠在另一个之上。我需要移动它们，以便它们按逻辑排列。

这是我需要做数千次的任务。我以前的解决方案结果不稳定。

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