使用宏在Excel中生成散点xy图

Question

我已经编写了一个宏来在Excel中生成图形，但我希望该图形在下一张纸中生成，而不是在同一张纸中。我已将我的宏粘贴到其正常工作的下方，我只想将其放在下一张纸中。请给我一些解决方案*

Sub LumData1()

    If IsEmpty(Range("B2,D2")) = False Then
        Range("B:B,D:D,H:H,I:I,J:J,M:M").Select
        Range("M1").Activate
        ActiveSheet.Shapes.AddChart.Select
        ActiveChart.ChartType = xlXYScatterSmoothNoMarkers
        ActiveChart.SetSourceData Source:=Sheets(ActiveSheet.Name).Range( _
            "$B:$B,$D:$D,$H:$H,$I:$I,$J:$J,$M:$M" _
            )
        ActiveChart.Location Where:=xlLocationAsObject, Name:=ActiveSheet.Name

        With ActiveChart.ChartArea
            .Width = 1060
            .Height = 420
            .Left = 0
        End With

        ActiveChart.SeriesCollection(1).Select
        ActiveChart.SeriesCollection(1).AxisGroup = 2
        ActiveChart.SeriesCollection(5).Select
        ActiveChart.SeriesCollection(5).AxisGroup = 2
        ActiveChart.Axes(xlCategory, xlPrimary).HasTitle = True
        ActiveChart.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Date"
        ActiveChart.Axes(xlValue, xlPrimary).HasTitle = True
        ActiveChart.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Value"
        ActiveChart.Axes(xlCategory).TickLabels.Orientation = 45
    End If

End Sub

Answer 1

我的回答不仅涵盖如何解决您帖子中的问题，还涵盖如何以“更干净”和更安全的方式在 VBA 中自动定义和设置图表。

最好避免使用

ActiveSheet

、

Select

和

ActiveChart

。相反，始终使用引用的对象，在本例中为

Worksheets

和

ChartObject

。例如

Dim ChtObj As ChartObject

，然后使用

Set ChtObj = ShtCht.ChartObjects.Add(100, 100, 500, 500)

设置它，其中

ShtCht

是您创建图表的工作表。

定义并设置

ChartObject

后，可以很容易地使用

With ChtObj

修改其属性，也可以通过在第一个

With .Chart.ChartArea

语句下添加

With

来修改嵌套属性。

代码

Option Explicit

Sub LumData1()

Dim ChtObj As ChartObject
Dim ShtSrc  As Worksheet
Dim ShtCht  As Worksheet

' change "Sheet1" to your sheet's name (where you have your chart's data)
Set ShtSrc = Worksheets("Sheet1") ' <-- I prefer not to work with ActiveSheet
 
'Set ShtCht = Worksheets("Sheet2") ' <-- set the chart's destination worksheet
Set ShtCht = Worksheets.Add ' <-- create a new worksheet to place the chart
ShtCht.Name = "Chart"

If Not IsEmpty(ShtSrc.Range("B2,D2")) Then

    Set ChtObj = ShtCht.ChartObjects.Add(100, 100, 500, 500)
    
    With ChtObj
        .Chart.ChartType = xlXYScatterSmoothNoMarkers
        .Chart.SetSourceData ShtSrc.Range("$B:$B,$D:$D,$H:$H,$I:$I,$J:$J,$M:$M")
                
        ' set position of the chart to Cell M1
        .Top = ShtCht.Range("M1").Top
        .Left = ShtCht.Range("M1").Left
        
        ' modify chart position and dimensions
        With .Chart.ChartArea
            .Width = 1060
            .Height = 420
            .Left = 0
        End With
        
        With .Chart
            .SeriesCollection(1).AxisGroup = 2
            .SeriesCollection(5).AxisGroup = 2
        
            .Axes(xlCategory, xlPrimary).HasTitle = True
            .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Date"
            .Axes(xlValue, xlPrimary).HasTitle = True
            .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Value"
            .Axes(xlCategory).TickLabels.Orientation = 45
        End With
    
    End With

End If

End Sub

Answer 2

编辑在OP澄清后，他必须制作一张新表来托管图表

尽可能坚持你的代码：

• 删除

  ActiveChart.Location Where:=xlLocationAsObject, Name:=ActiveSheet.Name

• 将以下代码放在

  End if

  之前

  Dim myChart As Chart: Set myChart = ActiveChart
  Worksheets.Add
  myChart.Location Where:=xlLocationAsObject, Name:=ActiveSheet.Name