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

我在excel工作簿中安排了一大組數據。每組數據包含R4，C192，每個數據表包含十組數據。此代碼創建10個圖表，每個數據集一個圖表。在創建圖表之後，它們被堆疊在另一個之上。我需要移動它們，以便它們按邏輯排列。如何使用VBA在Excel表格上安排圖表？

這是我需要做上千次的任務。我工作了以前的解決方案，結果不穩定。

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

來源

2017-03-27 JenV

'.top'和'.left' –

您可以在合適的地方放置圖表而進行。但是，既然你的例程工作正常，我不會觸及它，之後啓動這個宏來重新組織它們。

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

來源

2017-03-27 16:23:25

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

回答

相關問題