添加到从Excel中的多个工作表创buildgraphics的macros

我有一个excel文件，标有HI12981001.asvp，HI19281002.asvp，HI19281003.asvp等多个工作表。

在每张表中有2列没有标题。 我正在使用下面的macros来创build这两列中数据的散点图。 问题是我必须手动更改每个工作表的系列名称。

我正在寻找帮助build立在这个macros，以便我可以得到excel看一个列表（即HI12981001.asvp，HI19281002.asvp，HI19281003.asvp ..并在主图表中创build一个数据系列为每个工作表或简单浏览整本书并创build一个与表名相同的图表。

这只是前三张的macros

Sub zx() Dim wb As Workbook Dim sh As Worksheet Dim Chrt As Chart Dim Srs As Series Set wb = ActiveWorkbook Set Chrt = wb.Charts.Add(After:=wb.Worksheets(wb.Worksheets.Count)) Chrt.ChartType = xlXYScatterSmoothNoMarkers Chrt.Name = "SVP Profiles" Set Srs = Chrt.SeriesCollection.NewSeries Srs.Name = "HI12981001.asvp" Set sh = wb.Sheets("HI12981001.asvp") Srs.XValues = "=" & sh.Name & "!" & sh.UsedRange.Columns(2).Address Srs.Values = "=" & sh.Name & "!" & sh.UsedRange.Columns(1).Address Set Srs = Chrt.SeriesCollection.NewSeries Srs.Name = "HI12981002.asvp" Set sh = wb.Sheets("HI12981002.asvp") Srs.XValues = "=" & sh.Name & "!" & sh.UsedRange.Columns(2).Address Srs.Values = "=" & sh.Name & "!" & sh.UsedRange.Columns(1).Address Set Srs = Chrt.SeriesCollection.NewSeries Srs.Name = "HI12981003.asvp" Set sh = wb.Sheets("HI12981003.asvp") Srs.XValues = "=" & sh.Name & "!" & sh.UsedRange.Columns(2).Address Srs.Values = "=" & sh.Name & "!" & sh.UsedRange.Columns(1).Address End Sub 

谢谢

Answer 1

 Option Explicit Sub zx() Dim wb As Workbook Dim Chrt As Chart Set wb = ActiveWorkbook Set Chrt = wb.Charts.Add(After:=wb.Worksheets(wb.Worksheets.Count)) Chrt.ChartType = xlXYScatterSmoothNoMarkers Chrt.Name = "SVP Profiles" 'add the series AddNewSeries "HI12981001.asvp", wb, Chrt AddNewSeries "HI12981002.asvp", wb, Chrt AddNewSeries "HI12981003.asvp", wb, Chrt End Sub 'Add new series to chart 'cht', using sheet 'sheetName' ' in Workbook 'wb' Sub AddNewSeries(sheetName As String, wb As Workbook, cht As Chart) Dim sh As Worksheet Dim Srs As Series Set Srs = cht.SeriesCollection.NewSeries Srs.Name = sheetName Set sh = wb.Sheets(sheetName) Srs.XValues = "=" & sh.Name & "!" & sh.UsedRange.Columns(2).Address Srs.Values = "=" & sh.Name & "!" & sh.UsedRange.Columns(1).Address End Sub