Question

我为图表选择一个范围。创建后，我将放置在另一个名为“图表”的工作表上。我首先检查此表（“图表”）的存在，然后将其放置在适当的位置。但是我要实现的是，如果该位置已存在一个图表，并且已经说过I1，那么我希望将我创建的新图表转到I16。如果它也有一个图表，则应该移动到位置I31，直到找到一个空白点。

.spec.ports[*].nodePort

上图显示了图表如何重叠。我正在使用

  Dim blnFound As Boolean
blnFound = False
 '
 '
 ActiveChart.Parent.Cut

    End With
    For i = 1 To ActiveWorkbook.Sheets.Count
      If ActiveWorkbook.Sheets(i).Name = "Charts" Then
       Sheets("Charts").Select
        Range("I1").Select
        ActiveSheet.Paste
        blnFound = True
        Exit For
        End If

        Next i
    If blnFound = False Then
    Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Charts"
    Sheets("Charts").Select
    Range("I1").Select
    ActiveSheet.Paste
    End If

，然后按照代码粘贴如何在VBA代码中实现这一目标？

Answer 1

一种方法是递归调用相同的过程，该过程检查图表是否在您的范围内，并在再次检查之前将范围下移。

此代码将检查图表是否已经涵盖与您要放置的图表完全相同的范围。如果第二张图表与第一张图表重叠，则它将愉快地创建新图表，只有当两个图表都试图覆盖完全相同的范围时，它才会尝试将新图表向下移动。

注意-此示例代码仅创建图表容器，而不创建图表本身。
在chart行之后可以使用任何在chartobject中创建ChartObjects.Add的代码。

Sub Test()

    Add_Chart Sheet1.Range("C2:F5")

End Sub

Public Sub Add_Chart(Target As Range)

    Dim oCht As ChartObject 'The chart container.
    Dim bExists As Boolean  'Will be False when first created.

    'Look at each chart container on the sheet.
    For Each oCht In Target.Parent.ChartObjects
        If oCht.TopLeftCell.Address = Target.Cells(1, 1).Address And _
           oCht.BottomRightCell.Address = Target.Cells(Target.Rows.Count + 1, Target.Columns.Count + 1).Address Then
                bExists = True 'The chart does exist.
                Exit For 'No need to keep searching.
        End If
    Next oCht

    If bExists Then
        'Call this procedure again, but move the Target range down.
        Add_Chart Target.Offset(oCht.BottomRightCell.Row - oCht.TopLeftCell.Row)
    Else
        Target.Parent.ChartObjects.Add _
            Target.Left, Target.Top, Target.Width, Target.Height
    End If

End Sub

Answer 2

我会保持简单，通过查看其top和height属性，将下一个图表定位在上一个图表的下方。假设您已将工作表分配给名为ws的变量：

Dim nextPosition as double
Dim cObj as ChartObject

If ws.ChartObjects.Count = 0 then
   nextPosition = 1 ' there are no charts, paste the new one one point from the top of the window
Else
   set cObj= ws.ChartObjects(ws.ChartObjects.Count) ' get the most recently added chart...
   ' work out where to move the new chart by summing position & height of the previous chart
   nextPosition = cObj.Top + cObj.Height + 10 ' 10, or whatever padding you want between charts
End if

myChart.Copy
ws.Range("A1").select
ws.Paste

Set cObj= ws.ChartObjects(ws.ChartObjects.Count)
cObj.Top = nextPosition

vba-当前位置有图表时，如何在其他位置下方/下方放置图表

2 个答案: