VBA: организация объектов диаграммы на листе

У меня есть книга с несколькими таблицами диаграмм. Я хочу создать лист, где все диаграммы можно легко найти сразу, поэтому я могу быстро скопировать и затем вставить их в презентации PowerPoint.

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

Дело в том, что код вставляет их все в одну строку. Если, например, у меня есть большое количество диаграмм, поиск конкретного может занять слишком много времени.

Я хотел бы организовать все диаграммы в чем-то подобном, располагая определенное количество диаграмм для каждой строки (скажем, например, 2 диаграммы на строку).

введите описание изображения здесь

Я попытался использовать свойство .left для диаграмм, но он выравнивает все диаграммы с одним и тем же столбцом (и, пожалуйста, обратите внимание, что это не мое намерение).

Я также попытался ввести переменную для строк, но мне трудно контролировать, когда переменная должна «прыгать» для следующей строки, чтобы вставить диаграмму.

Любые идеи, если это возможно?

 Sub PasteCharts() Dim wb As Workbook Dim ws As Worksheet Dim Cht As Chart Dim Cht_ob As ChartObject Set wb = ActiveWorkbook Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Application.EnableEvents = False 'k is the column number for the address where the chart is to be pasted k = -1 For Each Cht In wb.Charts k = k + 1 Cht.Activate ActiveChart.ChartArea.Select ActiveChart.ChartArea.Copy Sheets("Gráficos").Select Cells(2, (k * 10) + 1).Select ActiveSheet.Paste Next Cht 'Changes the size of each chart pasted in the specific sheet For Each Cht_ob In Sheets("Gráficos").ChartObjects With Cht_ob .Height = 453.5433070866 .Width = 453.5433070866 End With Next Cht_ob Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Application.EnableEvents = True MsgBox ("All Charts were pasted successfully") End Sub 

Попробуйте код ниже, он скопирует >> вставьте все листы в свою книгу в лист «Графикос».

В настоящее время он вставляет нечетные диаграммы в столбце A и четные диаграммы в столбце K (вы можете легко изменять код).

Разрыв между каждыми 2 графиками составляет 30 строк (также может быть изменен в коде ниже).

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

Синтаксис размещения диаграммы в ячейке A1:

Cht_ob.Top = Sheets("Charts").Range("A1").Top

Код

 Option Explicit Sub PasteCharts() Dim wb As Workbook Dim ws As Worksheet Dim Cht As Chart Dim Cht_ob As ChartObject Dim k As Long Dim ChartRowCount As Long Set wb = ActiveWorkbook Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Application.EnableEvents = False k = 0 ' row number, increment every other 2 charts ChartRowCount = 1 ' column number, either 1 or 2 For Each Cht In wb.Charts Cht.ChartArea.Copy ' copy chart Sheets("Gráficos").Paste ' paste chart Set Cht_ob = Sheets("Gráficos").ChartObjects(Sheets("Charts").ChartObjects.Count) ' set chart object to pasted chart With Cht_ob If ChartRowCount = 1 Then .Top = Sheets("Gráficos").Range("A" & 1 + 30 * k).Top ' modify the top position .Left = Sheets("Gráficos").Range("A" & 1 + 30 * k).Left ' modify the left position ChartRowCount = ChartRowCount + 1 Else ' ChartRowCount = 2 .Top = Sheets("Gráficos").Range("K" & 1 + 30 * k).Top ' modify the top position .Left = Sheets("Gráficos").Range("K" & 1 + 30 * k).Left ' modify the left position ChartRowCount = 1 k = k + 1 End If .Height = 453.5433070866 .Width = 453.5433070866 End With Next Cht Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Application.EnableEvents = True MsgBox ("All Charts were pasted successfully") End Sub 

Я предлагаю другой метод, который идет непосредственно по координатам, а не по ячейкам:

 Sub PasteCharts() Dim cht As Chart, cht_ob As ChartObject, left As Long, top As Long Dim chartWidth As Long, chartHeight As Long, chartsPerRow As Long chartWidth = 200: chartHeight = 200: chartsPerRow = 4 ' <-- Set to your choice Application.ScreenUpdating = False: Application.EnableEvents = False On Error GoTo Cleanup For Each cht In ThisWorkbook.Charts Set cht_ob = Worksheets("Gráficos").ChartObjects.Add(left, top, chartWidth, chartHeight) cht.ChartArea.Copy cht_ob.Chart.Paste 'adjust coordinates for next chart object left = left + chartWidth If left > chartsPerRow * chartWidth * 0.99 Then left = 0 top = top + chartHeight End If Next msgBox ("All Charts were pasted successfully") Cleanup: Application.ScreenUpdating = True: Application.EnableEvents = True End Sub 
  • стандартный формат диаграммы
  • Как скопировать графики из Excel и внедрить их в PPT?
  • Создание диаграмм с использованием динамических диапазонов
  • Как организовать диаграммы на листе Excel с помощью VBA?
  • Диаграмма VBA: Показывает до последней непустой строки как исходные данные
  • Размещение VBA в другом листе
  • excel vba для запуска макроса из формулы ячейки
  • Насколько высоки легенды-записи в диаграмме Excel?
  • Не удается обновить диаграмму в Excel VBA (Excel 2016)
  • удалить графическое изображение без удаления диаграммы
  • Как настроить размер диаграммы для соответствия размеру страницы с помощью Excel VBA?
  • Interesting Posts

    Макроостановка без точки останова

    Использовать диапазон только с данными – Таблица Excel в Access

    В Excel VBA мне нужна 2 формула записи для метода европейских опционов Black-Scholes; Использование Select … Case

    Запись в Range.FormulaArray дает мне #NAME! ошибка

    Как найти родителя в иерархии с отступом?

    создавая формулу с минимумом нескольких ячеек, которая не превышает некоторого значения

    Для каждого свойства класса в Excel VBA

    Формула Excel вытащить данные из последних 5 строк диапазона ячеек, в которые добавлены новые строки ежедневно

    Как я могу вытащить каждый десятизначный код внутри ячейки и вставить его в новую ячейку?

    Vlookup Excel, ссылка на другой лист

    Как сохранить только значение LAST каждой пары в excel VBA?

    Расширенные фильтры Excel

    Диапазон. Ограничение результата формулы

    Использование функции поиска в вложенном состоянии, если в excel

    Цикл транспонирования в VBA

    Давайте будем гением компьютера.