时间戳

首页 > 解决方案 > 使用vba在工作表中有序排列图表

excel - 使用vba在工作表中有序排列图表

问题描述

我想安排我粘贴在目标工作表中的 8 个图表（来自两个目标 ws）。
我怎样才能组织图表，使它们在两行中彼此相邻粘贴（左上角：L7）？我的“源”ws 中有 2 乘以 4 个图表，但是当我运行宏时，目标 ws 似乎缺少最后一个图表（所以我实际上只有 7 个图表）

谢谢

    Dim OutSht As Worksheet
    Dim Chart As ChartObject
    Dim PlaceInRange As Range

    Set OutSht = ActiveWorkbook.Sheets("Guide") '<~~ Output sheet
    Set PlaceInRange = OutSht.Range("B2:J21")        '<~~ Output location

    'Loop charts
    For Each Chart In Sheets("Output").ChartObjects
        'Copy/paste charts
        Chart.Cut
        OutSht.Paste PlaceInRange
    Next Chart

    For Each Chart In Sheets("Uddybet").ChartObjects
        'Copy/paste charts
        Chart.Cut
        OutSht.Paste PlaceInRange
    Next Chart

标签： excelvbaloopsexcel-charts

解决方案

我不太确定这是否是您要找的东西！

我寻找图表所在的单元格，然后根据这些设置下一个图表位置。

可以简化代码，但我把它留给你！

Sub getCharts()
    Dim wsOutp As Worksheet: Set wsOutp = ActiveWorkbook.Sheets("Guide")
    Dim wsSrc1 As Worksheet: Set wsSrc1 = ActiveWorkbook.Sheets("Output")
    Dim wsSrc2 As Worksheet: Set wsSrc2 = ActiveWorkbook.Sheets("Uddybet")
    Dim x As Object
    
    Dim xTopLeftCellRow As Long, xBottomRightCellRow As Long
    Dim xTopLeftCellCol As Long, xBottomRightCellCol As Long
    Dim xDiffCols As Long
    Dim xRng As Range

    wsOutp.Select
    
    Dim aCell As Range: Set aCell = wsOutp.[B2]
    aCell.Activate
    
    ' Loop on sheet Output
    For Each x In wsSrc1.ChartObjects
        xTopLeftCellRow = x.TopLeftCell.Row
        xTopLeftCellCol = x.TopLeftCell.Column

        xBottomRightCellRow = x.BottomRightCell.Row
        xBottomRightCellCol = x.BottomRightCell.Column

        xDiffCols = xBottomRightCellCol - xTopLeftCellCol + 1
        
        ' Chart range
        Set xRng = Range(Cells(xTopLeftCellRow, xTopLeftCellCol), Cells(xBottomRightCellRow, xBottomRightCellCol))
                
        ' Move Chart
        x.Cut
        ActiveSheet.Paste
        
        ' Next chart position
        Set aCell = aCell.Offset(0, xDiffCols)
        aCell.Activate
    Next
    
    ' Loop on sheet Uddybet
    For Each x In wsSrc2.ChartObjects
        xTopLeftCellRow = x.TopLeftCell.Row
        xTopLeftCellCol = x.TopLeftCell.Column

        xBottomRightCellRow = x.BottomRightCell.Row
        xBottomRightCellCol = x.BottomRightCell.Column

        xDiffCols = xBottomRightCellCol - xTopLeftCellCol + 1
        
        ' Chart range
        Set xRng = Range(Cells(xTopLeftCellRow, xTopLeftCellCol), Cells(xBottomRightCellRow, xBottomRightCellCol))
                
        ' Move Chart
        x.Cut
        ActiveSheet.Paste
        
        ' Next chart position
        Set aCell = aCell.Offset(0, xDiffCols)
        aCell.Activate
    Next
End Sub

推荐阅读