时间戳

首页 > 解决方案 > VBA-一次复制多个图表

excel - VBA-一次复制多个图表

问题描述

我在工作表上共有 10 个图表，其中 5 个使用 SI 单位，另外 5 个使用 ANSI。每个都分为两个单独的列。5 个 ANSI 图表在“F”列中垂直对齐。5 个 SI 图表在“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

它们是如何排列的示例； 在此处输入图像描述

标签： excelchartsvba

解决方案

在一个循环中，你可以这样做：

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 行粘贴一次。

推荐阅读