使图表出现在单独的工作表上
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
图表在一个 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