如何使用VBA在Excel表格上安排图表？

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

这是我需要做几千次的任务。 我工作了以前的解决scheme不稳定的结果。

我想要 什么我有什么

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

继续操作时，您可以将图表放在正确的位置。 但是，既然你的例程工作正常，我不会触及它，只是之后启动这个macros来重新组织它们。

 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