VBA-копировать несколько графиков одновременно - PullRequest
Новая
       23

VBA-копировать несколько графиков одновременно

0 голосов
/ 22 мая 2018

У меня есть 10 диаграмм на листе, 5 из которых в единицах СИ, а остальные 5 в ANSI.Каждый разделен на две отдельные колонки.5 диаграмм ANSI выровнены по вертикали в столбце «F».5 диаграмм СИ выровнены по вертикали в столбце «O».

Я хочу скопировать только диаграммы в столбце «F».

Как бы мне было скопировать их все одновременно?

В настоящее время я копирую их по одному

Код: 

wb.Sheets(w).ChartObjects("Chart 9").Chart.ChartArea.Copy
With ThisWorkbook.Worksheets("Plots")
    .Activate
    .Range( "F2").Select
    .Pictures.Paste
End With
wb.Sheets(w).ChartObjects("Chart 13").Chart.ChartArea.Copy
With ThisWorkbook.Worksheets("Plots")
    .Activate
    .Range("F17").Select
    .Pictures.Paste
End With

wb.Sheets(w).ChartObjects("Chart 14").Chart.ChartArea.Copy
With ThisWorkbook.Worksheets("Plots")
    .Activate
    .Range("F32").Select
    .Pictures.Paste
End With

wb.Sheets(w).ChartObjects("Chart 15").Chart.ChartArea.Copy
With ThisWorkbook.Worksheets("Plots")
    .Activate
    .Range("F47").Select
    .Pictures.Paste
End With

wb.Sheets(w).ChartObjects("Chart 16").Chart.ChartArea.Copy
With ThisWorkbook.Worksheets("Plots")
    .Activate
    .Range("F64").Select
    .Pictures.Paste
End With

Пример того, как они устроены;enter image description here

1 Ответ

0 голосов
/ 22 мая 2018

В цикле вы можете сделать: 

Dim chartPasteRow as integer

chartPasteRow = 2
For each chartName in Array("Chart 9", "Chart 13", "Chart 14", "Chart 15", "Chart 16")
    wb.Sheets(w).ChartObjects(chartName).Chart.ChartArea.Copy
    ThisWorkbook.Worksheets("Plots").Range("F" & chartPasteRow).PasteSpecial xlPasteValues
    chartPasteRow = chartPasteRow + 15
Next chartName

Если вы хотите вставить все диаграммы без указания, вы можете сделать что-то вроде: 

Dim chartPasteRow as integer

chartPasteRow = 2
For each cht In wb.Sheets(w).ChartObjects
    cht.Chart.ChartArea.Copy
    ThisWorkbook.Worksheets("Plots").Range("F" & chartPasteRow).PasteSpecial xlPasteValues
    chartPasteRow = chartPasteRow + 15
Next cht

Это предполагаетчто каждый график будет вставлен каждые 15 строк.

...