使图表出现在单独的工作表上

Making charts appear on individual sheets

图表在一个 sheet 上一个接一个地显示,而不是在工作簿中的单个 sheet 上显示

我第一次尝试使用 VBA 制作图表。我的工作簿中有 17 个 sheet,我想生成除 sheet 1 (AllData) 之外的所有图表。我得到了所有 16 个 sheet 的基本图表(还没有弄清楚如何将 sheet 名称作为标题)但它们都一个接一个地出现在sheet 2. 我的目标是让它们出现在 lastrow.offset(3) 正下方的正确 sheet 上。我欢迎任何建议...

Sub Macro33()
Application.ScreenUpdating = True
Dim sh As Worksheet
Dim lastRow As Long
Dim ActiveWorksheet As Long
Dim ThisWorksheet As Long
Dim N As Integer
Dim rng As range
Dim cell As range
Dim r As range
Dim j As Integer
Dim x As Integer
x = Sheets.Count

For N = 2 To x

lastRow = Cells(Rows.Count, 1).End(xlUp).Row
range("I1:I" & lastRow).Select
ActiveSheet.Shapes.AddChart2(227, xlLineMarkers).Select
ActiveChart.SetSourceData Source:=Sheets(N).range("I2:I" & lastRow)
ActiveChart.Axes(xlCategory).Select
Application.CutCopyMode = False
Application.CutCopyMode = False
ActiveChart.FullSeriesCollection(1).XValues = Sheets(N).range("J2:J" & lastRow)


Application.ScreenUpdating = False


Next N

range("A1").Select
Application.ScreenUpdating = True
End Sub

您可以这样做:

Sub Macro33()

    Dim N As Long, cht As Chart, lastRow, s As Series
    
    For N = 2 To ThisWorkbook.Sheets.Count
        With ThisWorkbook.Sheets(N)
            
            lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
            Debug.Print .Parent.Name, .Name, lastRow '<<<<<<<<
            
            Set cht = .Shapes.AddChart2(227, xlLineMarkers).Chart
            'remove any auto-added series so we can start fresh
            Do While cht.SeriesCollection.Count > 0
                cht.SeriesCollection(1).Delete
            Loop
            
            'add series and set source
            Set s = cht.SeriesCollection.NewSeries
            s.XValues = .Range("J2:J" & lastRow)
            s.Values = .Range("I2:I" & lastRow)
            
            'position the chart's parent ChartObject 
            cht.Parent.Top = .Cells(lastRow + 3, 1).Top
            cht.Parent.Left = .Cells(lastRow + 3, 1).Left
        
        End With
    Next N

End Sub