Question

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

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

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

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

1 个答案: