【问题标题】:How do I arrange charts on an excel sheet using VBA?如何使用 VBA 在 Excel 工作表上排列图表?
【发布时间】:2017-03-27 15:55:32
【问题描述】:

我在 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

【问题讨论】:

  • .top.left

标签: excel vba charts


【解决方案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

【讨论】:

    猜你喜欢
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 2021-04-12
    • 1970-01-01
    相关资源
    最近更新 更多