You need to enable JavaScript to run this app.
优惠活动
大模型
产品
解决方案
定价
更多

如何将工作表中多幅图表以图片形式复制到另一工作簿并按序排列

Fixing Chart Copy-Paste: As Static Images & Non-Overlapping Placement

Let’s work through your two core issues step by step—turning linked charts into static images and arranging them neatly without overlap:

1. Copy Charts as Static Images (Not Linked to Source Data)

Instead of copying the ChartArea (which retains data references), use the CopyPicture method to capture the chart as a standalone image. This ensures you get a static snapshot that won’t update with changes to the original data.

2. Arrange Images From a Specified Cell (No Overlap)

We’ll define a starting cell for your first image, then calculate the position of each subsequent image based on the height of the previous one (plus a small gap for readability).

Full Working Code Example

Sub CopyChartsAsImagesAndArrange()
    Dim wb As Workbook
    Dim sourceSheet As Worksheet
    Dim targetSheet As Worksheet
    Dim startCell As Range
    Dim currentShape As Shape
    Dim nextTop As Double
    Dim chartNames As Variant
    Dim chartName As Variant
    
    ' Set your source workbook (replace with your actual workbook reference, e.g., Workbooks("SourceFile.xlsx"))
    Set wb = ' Add your source workbook here
    ' Set source sheet (use your existing "w" variable or replace with a sheet name like "Data")
    Set sourceSheet = wb.Sheets(w)
    ' Target sheet where images will be pasted
    Set targetSheet = ThisWorkbook.Sheets("Plots")
    ' Define your starting cell (adjust to your preferred position, e.g., "B2")
    Set startCell = targetSheet.Range("A1")
    
    ' List of charts to copy (add more chart names to this array as needed)
    chartNames = Array("Chart 27", "Chart 19")
    
    ' Initialize the top position with the starting cell's top
    nextTop = startCell.Top
    
    For Each chartName In chartNames
        ' Copy the chart as a screen-resolution picture
        sourceSheet.ChartObjects(chartName).Chart.CopyPicture _
            Appearance:=xlScreen, Format:=xlPicture
        
        ' Paste the image to the target sheet
        targetSheet.Paste
        ' Reference the newly pasted shape
        Set currentShape = targetSheet.Shapes(targetSheet.Shapes.Count)
        
        ' Align the image to the starting cell's left edge and calculated top position
        currentShape.Left = startCell.Left
        currentShape.Top = nextTop
        
        ' Update the top position for the next image (add 10 for vertical spacing—adjust as needed)
        nextTop = currentShape.Top + currentShape.Height + 10
    Next chartName
    
    ' Clear the clipboard to avoid accidental pastes
    Application.CutCopyMode = False
End Sub

Key Notes for Customization:

  • CopyPicture Options: Use Format:=xlBitmap instead of xlPicture if you prefer a bitmap image format. Appearance:=xlScreen ensures the image matches what you see on your screen.
  • Spacing & Position: Adjust the 10 value in nextTop = currentShape.Top + currentShape.Height + 10 to make the vertical gap between images larger or smaller. Change startCell to any cell (like "C3") to shift the starting position.
  • Adding More Charts: Just add additional chart names (e.g., "Chart 5") to the chartNames array to include more images.

内容的提问来源于stack exchange,提问作者dre

相关产品推荐
方舟 Agent Plan

超全模态模型 × Harness 升级,最新支持 Deepseek-V4.1-Flash、GLM-5.3 系列、Doubao-Seedream-5.0-pro、Kimi-K3 (部分), 限时 9.9 元起

最近更新时间:2026.05.26 08:53:52