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

Question

我想安排我粘贴在目标工作表中的8个图表(来自两个目标ws)。
我如何组织图表，使它们在两行中彼此相邻粘贴(左上角:L7) ?我的"源"里有2乘4个图表ws，但是当我运行宏时，最后一个图表似乎在目的地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

Answer 1

我不太确定这是否是你正在寻找的!

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

简化代码是可能的，但我把它留给你!

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