vba -Как разместить диаграмму ниже / вниз в другом месте, если в текущем месте существует диаграмма

Question

Я выбираю диапазон для диаграммы, которую нужно создать. После создания я помещаю на другой лист, который называется «диаграммы». Сначала я проверяю наличие этого листа - «диаграммы», а затем размещаю его на месте. Но я хочу добиться того, чтобы в этом месте уже существовала диаграмма с I1, а затем я хочу, чтобы новая созданная мной диаграмма перешла на I16. Если у него также есть график, то он должен переместиться в местоположение I31, пока не найдет пустое место.

  Dim blnFound As Boolean
blnFound = False
 '
 '
 ActiveChart.Parent.Cut

    End With
    For i = 1 To ActiveWorkbook.Sheets.Count
      If ActiveWorkbook.Sheets(i).Name = "Charts" Then
       Sheets("Charts").Select
        Range("I1").Select
        ActiveSheet.Paste
        blnFound = True
        Exit For
        End If

        Next i
    If blnFound = False Then
    Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Charts"
    Sheets("Charts").Select
    Range("I1").Select
    ActiveSheet.Paste
    End If

На изображении выше показано, как диаграммы перекрываются. Я использую

  .Parent.Cut 

и затем вставляем как в коде Как мне добиться этого в коде VBA?

Answer 1

Я бы оставил это простым и расположил следующий график чуть ниже предыдущего, посмотрев на его свойства top и height. Предполагая, что вы присвоили свой лист переменной ws:

Dim nextPosition as double
Dim cObj as ChartObject

If ws.ChartObjects.Count = 0 then
   nextPosition = 1 ' there are no charts, paste the new one one point from the top of the window
Else
   set cObj= ws.ChartObjects(ws.ChartObjects.Count) ' get the most recently added chart...
   ' work out where to move the new chart by summing position & height of the previous chart
   nextPosition = cObj.Top + cObj.Height + 10 ' 10, or whatever padding you want between charts
End if

myChart.Copy
ws.Range("A1").select
ws.Paste

Set cObj= ws.ChartObjects(ws.ChartObjects.Count)
cObj.Top = nextPosition 

Answer 2

Один из способов - это рекурсивно вызвать ту же процедуру, которая проверяет, существует ли диаграмма в вашем диапазоне, и передвинуть диапазон вниз перед повторной проверкой.

Этот код проверит, охватывает ли график точно такой же диапазон, как тот, который вы пытаетесь разместить. Если второй график перекрывает первый, то он с радостью создаст новый график, только если оба графика пытаются охватить точно такой же диапазон , он попытается переместить новый график вниз.

Примечание - этот пример кода создает только контейнер диаграммы, а не сам график.
Любой код для создания chart в chartobject будет идти после строки ChartObjects.Add.

Sub Test()

    Add_Chart Sheet1.Range("C2:F5")

End Sub

Public Sub Add_Chart(Target As Range)

    Dim oCht As ChartObject 'The chart container.
    Dim bExists As Boolean  'Will be False when first created.

    'Look at each chart container on the sheet.
    For Each oCht In Target.Parent.ChartObjects
        If oCht.TopLeftCell.Address = Target.Cells(1, 1).Address And _
           oCht.BottomRightCell.Address = Target.Cells(Target.Rows.Count + 1, Target.Columns.Count + 1).Address Then
                bExists = True 'The chart does exist.
                Exit For 'No need to keep searching.
        End If
    Next oCht

    If bExists Then
        'Call this procedure again, but move the Target range down.
        Add_Chart Target.Offset(oCht.BottomRightCell.Row - oCht.TopLeftCell.Row)
    Else
        Target.Parent.ChartObjects.Add _
            Target.Left, Target.Top, Target.Width, Target.Height
    End If

End Sub