Как упорядочить диаграммы в Excel с помощью VBA?

Question

У меня есть этот код, но когда VBA копирует и вставляет диаграммы на Excelsheet, диаграммы перекрываются.

Есть ли способ организовать их в 1 колонке без перекрытия?

Спасибо!

Sub Test1() 

Dim cht As Excel.ChartObject 

Worksheets("ChartObjects").ChartObjects.Delete 

For Each Sheet In ActiveWorkbook.Worksheets 
If Sheet.Name <> "ChartObjects" Then 

Sheet.Select 
For Each cht In Sheet.ChartObjects 

cht.Select 
cht.Copy 

Sheets("ChartObjects").Select 
Range("C5").Select 
ActiveSheet.Paste 

Next 

End If 
Next Sheet 

End Sub 

Answer 1

Вы можете использовать .Top и .Left свойства клетки, и .Top и .Height свойства каждого ChartObject, чтобы выровнять каждую последующую диаграмму с нижней предыдущего графика:

Sub foo() 
Dim cht As ChartObject 
Dim newCht As ChartObject 
Dim sht As Worksheet 
Dim chtSht As Worksheet 
Dim top As Double 
Dim left As Double 

'Define the destination worksheet 
Set chtSht = ActiveWorkbook.Worksheets("ChartObjects") 

'Define the starting parameter for the charts 
With chtSht.Range("C5") 
    top = .top 
    left = .left 
End With 

'Iterate the sheets in the workbook 
For Each sht In ActiveWorkbook.Worksheets 
    'Ignore the chtSheet 
    If Not sht.Name = chtSht.Name Then 
     'Iterate the charts in each worksheet 
     For Each cht In sht.ChartObjects 
      'Copy the chart 
      cht.Copy 
      'Paste it in to the destination sheet 
      chtSht.Paste 
      'Get a handle on the chart we just pasted 
      Set newCht = chtSht.ChartObjects(chtSht.ChartObjects.Count) 

      'Assign the top location of this chart 
      newCht.top = top 
      newCht.left = left 
      'Add with the height of this chart to determine the "top" for the next chart 
      top = newCht.top + newCht.Height 

     Next 
    End If 
Next 
End Sub