提高速度，缩短excel VBA MACRO的代码
在使用VBA方面，我非常新，我写了一个macros的代码，最初构build了16个图表，然后以.jpeg格式导出图表。 代码不难理解。 在要select的数据，图表名称和图表在工作簿中的位置只有一些小的差异。 它的基本上几乎相同的代码乘以16次创build图表和另外16次导出它们。
代码工作正常，但需要大约20 – 30秒运行。 你有什么想法，我怎么让它跑得更快？
任何input是受欢迎的。 感谢您的时间。
第一部分创build图表
Sub Export() Dim objChrt As ChartObject Dim myChart As Chart Dim sh As Worksheet ThisWorkbook.Sheets(1).Name = "Sheet1" Set sh = ActiveWorkbook.Worksheets("Sheet1") 'S11-S14 Set mychrt = sh.Shapes.AddChart.Chart Set chrta = sh.Shapes.AddChart.Chart Set chrtb = sh.Shapes.AddChart.Chart Set chrtc = sh.Shapes.AddChart.Chart 'S21-S24 Set chrtd = sh.Shapes.AddChart.Chart Set chrte = sh.Shapes.AddChart.Chart Set chrtf = sh.Shapes.AddChart.Chart Set chrtg = sh.Shapes.AddChart.Chart 'S31-S34 Set chrth = sh.Shapes.AddChart.Chart Set chrti = sh.Shapes.AddChart.Chart Set chrtj = sh.Shapes.AddChart.Chart Set chrtk = sh.Shapes.AddChart.Chart 'S41-S44 Set chrtl = sh.Shapes.AddChart.Chart Set chrtm = sh.Shapes.AddChart.Chart Set chrtn = sh.Shapes.AddChart.Chart Set chrto = sh.Shapes.AddChart.Chart '/////////S11-S14\\\\\\\\\\\\ With mychrt 'S11 ' Chart type and source selection .ChartType = xlXYScatterSmoothNoMarkers .SeriesCollection.NewSeries .SeriesCollection(1).Name = "=Sheet1!$C$5" .SeriesCollection(1).XValues = "=Sheet1!$B$807:$B$1006" .SeriesCollection(1).Values = "=Sheet1!$C$807:$C$1006" ' Color .SeriesCollection(1).Border.ColorIndex = 3 'change to suit ' Titles .Axes(xlValue, xlPrimary).HasTitle = True .Axes(xlValue, xlPrimary).AxisTitle.Text = "Gain(dB)" .Axes(xlCategory, xlPrimary).HasTitle = True .Axes(xlCategory, xlPrimary).AxisTitle.Text = "Frequency (Hz)" .HasTitle = True .ChartTitle.Text = "S11" ' Scale settings .Axes(xlCategory).Select .Axes(xlCategory).MinimumScale = 2400000000# .Axes(xlCategory).MaximumScale = 2500000000# .Axes(xlCategory).HasMajorGridlines = True Selection.TickLabelPosition = xlLow .Axes(xlValue).Select .Axes(xlValue).MinimumScale = -40 .Axes(xlValue).MaximumScale = 0 .Axes(xlValue).HasMajorGridlines = True ' Position and size .ChartArea.Top = 10 .ChartArea.Left = 1700 .ChartArea.Height = 400 .ChartArea.Width = 750 End With With chrta 'S12 ' Chart type and source selection .ChartType = xlXYScatterSmoothNoMarkers .SeriesCollection.NewSeries .SeriesCollection(1).Name = "=Sheet1!$E$5" .SeriesCollection(1).XValues = "=Sheet1!$B$807:$B$1006" .SeriesCollection(1).Values = "=Sheet1!$E$807:$E$1006" ' Color .SeriesCollection(1).Border.ColorIndex = 43 'change to suit (Green) ' Titles .Axes(xlValue, xlPrimary).HasTitle = True .Axes(xlValue, xlPrimary).AxisTitle.Text = "Gain(dB)" .Axes(xlCategory, xlPrimary).HasTitle = True .Axes(xlCategory, xlPrimary).AxisTitle.Text = "Frequency (Hz)" .HasTitle = True .ChartTitle.Text = "S12" ' Scale settings .Axes(xlCategory).Select .Axes(xlCategory).MinimumScale = 2400000000# .Axes(xlCategory).MaximumScale = 2500000000# .Axes(xlCategory).HasMajorGridlines = True Selection.TickLabelPosition = xlLow .Axes(xlValue).Select .Axes(xlValue).MinimumScale = -40 .Axes(xlValue).MaximumScale = 0 .Axes(xlValue).HasMajorGridlines = True ' Position and size .ChartArea.Top = 10 .ChartArea.Left = 2460 .ChartArea.Height = 400 .ChartArea.Width = 750 End With With chrtb ' Chart type and source selection .ChartType = xlXYScatterSmoothNoMarkers .SeriesCollection.NewSeries .SeriesCollection(1).Name = "=Sheet1!$g$5" .SeriesCollection(1).XValues = "=Sheet1!$B$807:$B$1006" .SeriesCollection(1).Values = "=Sheet1!$g$807:$g$1006" ' Color .SeriesCollection(1).Border.ColorIndex = 43 'change to suit ' Titles .Axes(xlValue, xlPrimary).HasTitle = True .Axes(xlValue, xlPrimary).AxisTitle.Text = "Gain(dB)" .Axes(xlCategory, xlPrimary).HasTitle = True .Axes(xlCategory, xlPrimary).AxisTitle.Text = "Frequency (Hz)" .HasTitle = True .ChartTitle.Text = "S13" ' Scale settings .Axes(xlCategory).Select .Axes(xlCategory).MinimumScale = 2400000000# .Axes(xlCategory).MaximumScale = 2500000000# .Axes(xlCategory).HasMajorGridlines = True Selection.TickLabelPosition = xlLow .Axes(xlValue).Select .Axes(xlValue).MinimumScale = -40 .Axes(xlValue).MaximumScale = 0 .Axes(xlValue).HasMajorGridlines = True ' Position and size .ChartArea.Top = 10 .ChartArea.Left = 3220 .ChartArea.Height = 400 .ChartArea.Width = 750 End With With chrtc ' Chart type and source selection .ChartType = xlXYScatterSmoothNoMarkers .SeriesCollection.NewSeries .SeriesCollection(1).Name = "=Sheet1!$i$5" .SeriesCollection(1).XValues = "=Sheet1!$B$807:$B$1006" .SeriesCollection(1).Values = "=Sheet1!$i$807:$i$1006" ' Color .SeriesCollection(1).Border.ColorIndex = 43 'change to suit ' Titles .Axes(xlValue, xlPrimary).HasTitle = True .Axes(xlValue, xlPrimary).AxisTitle.Text = "Gain(dB)" .Axes(xlCategory, xlPrimary).HasTitle = True .Axes(xlCategory, xlPrimary).AxisTitle.Text = "Frequency (Hz)" .HasTitle = True .ChartTitle.Text = "S14" ' Scale settings .Axes(xlCategory).Select .Axes(xlCategory).MinimumScale = 2400000000# .Axes(xlCategory).MaximumScale = 2500000000# .Axes(xlCategory).HasMajorGridlines = True Selection.TickLabelPosition = xlLow .Axes(xlValue).Select .Axes(xlValue).MinimumScale = -40 .Axes(xlValue).MaximumScale = 0 .Axes(xlValue).HasMajorGridlines = True ' Position and size .ChartArea.Top = 10 .ChartArea.Left = 3980 .ChartArea.Height = 400 .ChartArea.Width = 750 End With '/////////S21-S24\\\\\\\\\\\\ With chrtd 'S21 ' Chart type and source selection .ChartType = xlXYScatterSmoothNoMarkers .SeriesCollection.NewSeries .SeriesCollection(1).Name = "=Sheet1!$k$5" .SeriesCollection(1).XValues = "=Sheet1!$B$807:$B$1006" .SeriesCollection(1).Values = "=Sheet1!$k$807:$k$1006" ' Color .SeriesCollection(1).Border.ColorIndex = 41 'change to suit ' Titles .Axes(xlValue, xlPrimary).HasTitle = True .Axes(xlValue, xlPrimary).AxisTitle.Text = "Gain(dB)" .Axes(xlCategory, xlPrimary).HasTitle = True .Axes(xlCategory, xlPrimary).AxisTitle.Text = "Frequency (Hz)" .HasTitle = True .ChartTitle.Text = "S21" ' Scale settings .Axes(xlCategory).Select .Axes(xlCategory).MinimumScale = 2400000000# .Axes(xlCategory).MaximumScale = 2500000000# .Axes(xlCategory).HasMajorGridlines = True Selection.TickLabelPosition = xlLow .Axes(xlValue).Select .Axes(xlValue).MinimumScale = -40 .Axes(xlValue).MaximumScale = 0 .Axes(xlValue).HasMajorGridlines = True ' Position and size .ChartArea.Top = 420 .ChartArea.Left = 1700 .ChartArea.Height = 400 .ChartArea.Width = 750 End With With chrte 'S22 ' Chart type and source selection .ChartType = xlXYScatterSmoothNoMarkers .SeriesCollection.NewSeries .SeriesCollection(1).Name = "=Sheet1!$m$5" .SeriesCollection(1).XValues = "=Sheet1!$B$807:$B$1006" .SeriesCollection(1).Values = "=Sheet1!$m$807:$m$1006" ' Color .SeriesCollection(1).Border.ColorIndex = 3 'change to suit (Green) ' Titles .Axes(xlValue, xlPrimary).HasTitle = True .Axes(xlValue, xlPrimary).AxisTitle.Text = "Gain(dB)" .Axes(xlCategory, xlPrimary).HasTitle = True .Axes(xlCategory, xlPrimary).AxisTitle.Text = "Frequency (Hz)" .HasTitle = True .ChartTitle.Text = "S22" ' Scale settings .Axes(xlCategory).Select .Axes(xlCategory).MinimumScale = 2400000000# .Axes(xlCategory).MaximumScale = 2500000000# .Axes(xlCategory).HasMajorGridlines = True Selection.TickLabelPosition = xlLow .Axes(xlValue).Select .Axes(xlValue).MinimumScale = -40 .Axes(xlValue).MaximumScale = 0 .Axes(xlValue).HasMajorGridlines = True ' Position and size .ChartArea.Top = 420 .ChartArea.Left = 2460 .ChartArea.Height = 400 .ChartArea.Width = 750 End With With chrtf 'S23 ' Chart type and source selection .ChartType = xlXYScatterSmoothNoMarkers .SeriesCollection.NewSeries .SeriesCollection(1).Name = "=Sheet1!$o$5" .SeriesCollection(1).XValues = "=Sheet1!$B$807:$B$1006" .SeriesCollection(1).Values = "=Sheet1!$o$807:$o$1006" ' Color .SeriesCollection(1).Border.ColorIndex = 43 'change to suit ' Titles .Axes(xlValue, xlPrimary).HasTitle = True .Axes(xlValue, xlPrimary).AxisTitle.Text = "Gain(dB)" .Axes(xlCategory, xlPrimary).HasTitle = True .Axes(xlCategory, xlPrimary).AxisTitle.Text = "Frequency (Hz)" .HasTitle = True .ChartTitle.Text = "S23" ' Scale settings .Axes(xlCategory).Select .Axes(xlCategory).MinimumScale = 2400000000# .Axes(xlCategory).MaximumScale = 2500000000# .Axes(xlCategory).HasMajorGridlines = True Selection.TickLabelPosition = xlLow .Axes(xlValue).Select .Axes(xlValue).MinimumScale = -40 .Axes(xlValue).MaximumScale = 0 .Axes(xlValue).HasMajorGridlines = True ' Position and size .ChartArea.Top = 420 .ChartArea.Left = 3220 .ChartArea.Height = 400 .ChartArea.Width = 750 End With With chrtg 'S24 ' Chart type and source selection .ChartType = xlXYScatterSmoothNoMarkers .SeriesCollection.NewSeries .SeriesCollection(1).Name = "=Sheet1!$q$5" .SeriesCollection(1).XValues = "=Sheet1!$B$807:$B$1006" .SeriesCollection(1).Values = "=Sheet1!$q$807:$q$1006" ' Color .SeriesCollection(1).Border.ColorIndex = 43 'change to suit ' Titles .Axes(xlValue, xlPrimary).HasTitle = True .Axes(xlValue, xlPrimary).AxisTitle.Text = "Gain(dB)" .Axes(xlCategory, xlPrimary).HasTitle = True .Axes(xlCategory, xlPrimary).AxisTitle.Text = "Frequency (Hz)" .HasTitle = True .ChartTitle.Text = "S24" ' Scale settings .Axes(xlCategory).Select .Axes(xlCategory).MinimumScale = 2400000000# .Axes(xlCategory).MaximumScale = 2500000000# .Axes(xlCategory).HasMajorGridlines = True Selection.TickLabelPosition = xlLow .Axes(xlValue).Select .Axes(xlValue).MinimumScale = -40 .Axes(xlValue).MaximumScale = 0 .Axes(xlValue).HasMajorGridlines = True ' Position and size .ChartArea.Top = 420 .ChartArea.Left = 3980 .ChartArea.Height = 400 .ChartArea.Width = 750 End With '/////////S31-S34\\\\\\\\\\\\ With chrth 'S31 ' Chart type and source selection .ChartType = xlXYScatterSmoothNoMarkers .SeriesCollection.NewSeries .SeriesCollection(1).Name = "=Sheet1!$s$5" .SeriesCollection(1).XValues = "=Sheet1!$B$807:$B$1006" .SeriesCollection(1).Values = "=Sheet1!$s$807:$s$1006" ' Color .SeriesCollection(1).Border.ColorIndex = 41 'change to suit ' Titles .Axes(xlValue, xlPrimary).HasTitle = True .Axes(xlValue, xlPrimary).AxisTitle.Text = "Gain(dB)" .Axes(xlCategory, xlPrimary).HasTitle = True .Axes(xlCategory, xlPrimary).AxisTitle.Text = "Frequency (Hz)" .HasTitle = True .ChartTitle.Text = "S31" ' Scale settings .Axes(xlCategory).Select .Axes(xlCategory).MinimumScale = 2400000000# .Axes(xlCategory).MaximumScale = 2500000000# .Axes(xlCategory).HasMajorGridlines = True Selection.TickLabelPosition = xlLow .Axes(xlValue).Select .Axes(xlValue).MinimumScale = -40 .Axes(xlValue).MaximumScale = 0 .Axes(xlValue).HasMajorGridlines = True ' Position and size .ChartArea.Top = 830 .ChartArea.Left = 1700 .ChartArea.Height = 400 .ChartArea.Width = 750 End With With chrti 'S32 ' Chart type and source selection .ChartType = xlXYScatterSmoothNoMarkers .SeriesCollection.NewSeries .SeriesCollection(1).Name = "=Sheet1!$u$5" .SeriesCollection(1).XValues = "=Sheet1!$B$807:$B$1006" .SeriesCollection(1).Values = "=Sheet1!$u$807:$u$1006" ' Color .SeriesCollection(1).Border.ColorIndex = 41 'change to suit (Green) ' Titles .Axes(xlValue, xlPrimary).HasTitle = True .Axes(xlValue, xlPrimary).AxisTitle.Text = "Gain(dB)" .Axes(xlCategory, xlPrimary).HasTitle = True .Axes(xlCategory, xlPrimary).AxisTitle.Text = "Frequency (Hz)" .HasTitle = True .ChartTitle.Text = "S32" ' Scale settings .Axes(xlCategory).Select .Axes(xlCategory).MinimumScale = 2400000000# .Axes(xlCategory).MaximumScale = 2500000000# .Axes(xlCategory).HasMajorGridlines = True Selection.TickLabelPosition = xlLow .Axes(xlValue).Select .Axes(xlValue).MinimumScale = -40 .Axes(xlValue).MaximumScale = 0 .Axes(xlValue).HasMajorGridlines = True ' Position and size .ChartArea.Top = 830 .ChartArea.Left = 2460 .ChartArea.Height = 400 .ChartArea.Width = 750 End With With chrtj 'S33 ' Chart type and source selection .ChartType = xlXYScatterSmoothNoMarkers .SeriesCollection.NewSeries .SeriesCollection(1).Name = "=Sheet1!$w$5" .SeriesCollection(1).XValues = "=Sheet1!$B$807:$B$1006" .SeriesCollection(1).Values = "=Sheet1!$w$807:$w$1006" ' Color .SeriesCollection(1).Border.ColorIndex = 3 'change to suit ' Titles .Axes(xlValue, xlPrimary).HasTitle = True .Axes(xlValue, xlPrimary).AxisTitle.Text = "Gain(dB)" .Axes(xlCategory, xlPrimary).HasTitle = True .Axes(xlCategory, xlPrimary).AxisTitle.Text = "Frequency (Hz)" .HasTitle = True .ChartTitle.Text = "S33" ' Scale settings .Axes(xlCategory).Select .Axes(xlCategory).MinimumScale = 2400000000# .Axes(xlCategory).MaximumScale = 2500000000# .Axes(xlCategory).HasMajorGridlines = True Selection.TickLabelPosition = xlLow .Axes(xlValue).Select .Axes(xlValue).MinimumScale = -40 .Axes(xlValue).MaximumScale = 0 .Axes(xlValue).HasMajorGridlines = True ' Position and size .ChartArea.Top = 830 .ChartArea.Left = 3220 .ChartArea.Height = 400 .ChartArea.Width = 750 End With With chrtk 'S34 ' Chart type and source selection .ChartType = xlXYScatterSmoothNoMarkers .SeriesCollection.NewSeries .SeriesCollection(1).Name = "=Sheet1!$y$5" .SeriesCollection(1).XValues = "=Sheet1!$B$807:$B$1006" .SeriesCollection(1).Values = "=Sheet1!$y$807:$y$1006" ' Color .SeriesCollection(1).Border.ColorIndex = 43 'change to suit ' Titles .Axes(xlValue, xlPrimary).HasTitle = True .Axes(xlValue, xlPrimary).AxisTitle.Text = "Gain(dB)" .Axes(xlCategory, xlPrimary).HasTitle = True .Axes(xlCategory, xlPrimary).AxisTitle.Text = "Frequency (Hz)" .HasTitle = True .ChartTitle.Text = "S34" ' Scale settings .Axes(xlCategory).Select .Axes(xlCategory).MinimumScale = 2400000000# .Axes(xlCategory).MaximumScale = 2500000000# .Axes(xlCategory).HasMajorGridlines = True Selection.TickLabelPosition = xlLow .Axes(xlValue).Select .Axes(xlValue).MinimumScale = -40 .Axes(xlValue).MaximumScale = 0 .Axes(xlValue).HasMajorGridlines = True ' Position and size .ChartArea.Top = 830 .ChartArea.Left = 3980 .ChartArea.Height = 400 .ChartArea.Width = 750 End With '/////////S41-S44\\\\\\\\\\\\ With chrtl 'S41 ' Chart type and source selection .ChartType = xlXYScatterSmoothNoMarkers .SeriesCollection.NewSeries .SeriesCollection(1).Name = "=Sheet1!$AA$5" .SeriesCollection(1).XValues = "=Sheet1!$B$807:$B$1006" .SeriesCollection(1).Values = "=Sheet1!$AA$807:$AA$1006" ' Color .SeriesCollection(1).Border.ColorIndex = 41 'change to suit ' Titles .Axes(xlValue, xlPrimary).HasTitle = True .Axes(xlValue, xlPrimary).AxisTitle.Text = "Gain(dB)" .Axes(xlCategory, xlPrimary).HasTitle = True .Axes(xlCategory, xlPrimary).AxisTitle.Text = "Frequency (Hz)" .HasTitle = True .ChartTitle.Text = "S41" ' Scale settings .Axes(xlCategory).Select .Axes(xlCategory).MinimumScale = 2400000000# .Axes(xlCategory).MaximumScale = 2500000000# .Axes(xlCategory).HasMajorGridlines = True Selection.TickLabelPosition = xlLow .Axes(xlValue).Select .Axes(xlValue).MinimumScale = -40 .Axes(xlValue).MaximumScale = 0 .Axes(xlValue).HasMajorGridlines = True ' Position and size .ChartArea.Top = 1240 .ChartArea.Left = 1700 .ChartArea.Height = 400 .ChartArea.Width = 750 End With With chrtm 'S42 ' Chart type and source selection .ChartType = xlXYScatterSmoothNoMarkers .SeriesCollection.NewSeries .SeriesCollection(1).Name = "=Sheet1!$ac$5" .SeriesCollection(1).XValues = "=Sheet1!$B$807:$B$1006" .SeriesCollection(1).Values = "=Sheet1!$ac$807:$ac$1006" ' Color .SeriesCollection(1).Border.ColorIndex = 41 'change to suit (Green) ' Titles .Axes(xlValue, xlPrimary).HasTitle = True .Axes(xlValue, xlPrimary).AxisTitle.Text = "Gain(dB)" .Axes(xlCategory, xlPrimary).HasTitle = True .Axes(xlCategory, xlPrimary).AxisTitle.Text = "Frequency (Hz)" .HasTitle = True .ChartTitle.Text = "S42" ' Scale settings .Axes(xlCategory).Select .Axes(xlCategory).MinimumScale = 2400000000# .Axes(xlCategory).MaximumScale = 2500000000# .Axes(xlCategory).HasMajorGridlines = True Selection.TickLabelPosition = xlLow .Axes(xlValue).Select .Axes(xlValue).MinimumScale = -40 .Axes(xlValue).MaximumScale = 0 .Axes(xlValue).HasMajorGridlines = True ' Position and size .ChartArea.Top = 1240 .ChartArea.Left = 2460 .ChartArea.Height = 400 .ChartArea.Width = 750 End With With chrtn 'S43 ' Chart type and source selection .ChartType = xlXYScatterSmoothNoMarkers .SeriesCollection.NewSeries .SeriesCollection(1).Name = "=Sheet1!$ae$5" .SeriesCollection(1).XValues = "=Sheet1!$B$807:$B$1006" .SeriesCollection(1).Values = "=Sheet1!$ae$807:$ae$1006" ' Color .SeriesCollection(1).Border.ColorIndex = 41 'change to suit ' Titles .Axes(xlValue, xlPrimary).HasTitle = True .Axes(xlValue, xlPrimary).AxisTitle.Text = "Gain(dB)" .Axes(xlCategory, xlPrimary).HasTitle = True .Axes(xlCategory, xlPrimary).AxisTitle.Text = "Frequency (Hz)" .HasTitle = True .ChartTitle.Text = "S43" ' Scale settings .Axes(xlCategory).Select .Axes(xlCategory).MinimumScale = 2400000000# .Axes(xlCategory).MaximumScale = 2500000000# .Axes(xlCategory).HasMajorGridlines = True Selection.TickLabelPosition = xlLow .Axes(xlValue).Select .Axes(xlValue).MinimumScale = -40 .Axes(xlValue).MaximumScale = 0 .Axes(xlValue).HasMajorGridlines = True ' Position and size .ChartArea.Top = 1240 .ChartArea.Left = 3220 .ChartArea.Height = 400 .ChartArea.Width = 750 End With With chrto 'S44 ' Chart type and source selection .ChartType = xlXYScatterSmoothNoMarkers .SeriesCollection.NewSeries .SeriesCollection(1).Name = "=Sheet1!$ag$5" .SeriesCollection(1).XValues = "=Sheet1!$B$807:$B$1006" .SeriesCollection(1).Values = "=Sheet1!$ag$807:$ag$1006" ' Color .SeriesCollection(1).Border.ColorIndex = 3 'change to suit ' Titles .Axes(xlValue, xlPrimary).HasTitle = True .Axes(xlValue, xlPrimary).AxisTitle.Text = "Gain(dB)" .Axes(xlCategory, xlPrimary).HasTitle = True .Axes(xlCategory, xlPrimary).AxisTitle.Text = "Frequency (Hz)" .HasTitle = True .ChartTitle.Text = "S44" ' Scale settings .Axes(xlCategory).Select .Axes(xlCategory).MinimumScale = 2400000000# .Axes(xlCategory).MaximumScale = 2500000000# .Axes(xlCategory).HasMajorGridlines = True Selection.TickLabelPosition = xlLow .Axes(xlValue).Select .Axes(xlValue).MinimumScale = -40 .Axes(xlValue).MaximumScale = 0 .Axes(xlValue).HasMajorGridlines = True ' Position and size .ChartArea.Top = 1240 .ChartArea.Left = 3980 .ChartArea.Height = 400 .ChartArea.Width = 750 End With 第二部分导出图表
Set objChrt = ActiveSheet.ChartObjects(1) Set myChart = objChrt.Chart myFileName = ActiveWorkbook.Name & " " & "S11.JPEG" On Error Resume Next Kill ActiveWorkbook.Path & "\" & myFileName On Error GoTo 0 myChart.Export Filename:=ActiveWorkbook.Path & "\" & myFileName, Filtername:="JPEG" Set objChrt = ActiveSheet.ChartObjects(2) Set myChart = objChrt.Chart myFileName = ActiveWorkbook.Name & " " & "S12.JPEG" On Error Resume Next Kill ActiveWorkbook.Path & "\" & myFileName On Error GoTo 0 myChart.Export Filename:=ActiveWorkbook.Path & "\" & myFileName, Filtername:="JPEG" Set objChrt = ActiveSheet.ChartObjects(3) Set myChart = objChrt.Chart myFileName = ActiveWorkbook.Name & " " & "S13.JPEG" On Error Resume Next Kill ActiveWorkbook.Path & "\" & myFileName On Error GoTo 0 myChart.Export Filename:=ActiveWorkbook.Path & "\" & myFileName, Filtername:="JPEG" Set objChrt = ActiveSheet.ChartObjects(4) Set myChart = objChrt.Chart myFileName = ActiveWorkbook.Name & " " & "S14.JPEG" On Error Resume Next Kill ActiveWorkbook.Path & "\" & myFileName On Error GoTo 0 myChart.Export Filename:=ActiveWorkbook.Path & "\" & myFileName, Filtername:="JPEG" Set objChrt = ActiveSheet.ChartObjects(5) Set myChart = objChrt.Chart myFileName = ActiveWorkbook.Name & " " & "S21.JPEG" On Error Resume Next Kill ActiveWorkbook.Path & "\" & myFileName On Error GoTo 0 myChart.Export Filename:=ActiveWorkbook.Path & "\" & myFileName, Filtername:="JPEG" Set objChrt = ActiveSheet.ChartObjects(6) Set myChart = objChrt.Chart myFileName = ActiveWorkbook.Name & " " & "S22.JPEG" On Error Resume Next Kill ActiveWorkbook.Path & "\" & myFileName On Error GoTo 0 myChart.Export Filename:=ActiveWorkbook.Path & "\" & myFileName, Filtername:="JPEG" Set objChrt = ActiveSheet.ChartObjects(7) Set myChart = objChrt.Chart myFileName = ActiveWorkbook.Name & " " & "S23.JPEG" On Error Resume Next Kill ActiveWorkbook.Path & "\" & myFileName On Error GoTo 0 myChart.Export Filename:=ActiveWorkbook.Path & "\" & myFileName, Filtername:="JPEG" Set objChrt = ActiveSheet.ChartObjects(8) Set myChart = objChrt.Chart myFileName = ActiveWorkbook.Name & " " & "S24.JPEG" On Error Resume Next Kill ActiveWorkbook.Path & "\" & myFileName On Error GoTo 0 myChart.Export Filename:=ActiveWorkbook.Path & "\" & myFileName, Filtername:="JPEG" Set objChrt = ActiveSheet.ChartObjects(9) Set myChart = objChrt.Chart myFileName = ActiveWorkbook.Name & " " & "S31.JPEG" On Error Resume Next Kill ActiveWorkbook.Path & "\" & myFileName On Error GoTo 0 myChart.Export Filename:=ActiveWorkbook.Path & "\" & myFileName, Filtername:="JPEG" Set objChrt = ActiveSheet.ChartObjects(10) Set myChart = objChrt.Chart myFileName = ActiveWorkbook.Name & " " & "S32.JPEG" On Error Resume Next Kill ActiveWorkbook.Path & "\" & myFileName On Error GoTo 0 myChart.Export Filename:=ActiveWorkbook.Path & "\" & myFileName, Filtername:="JPEG" Set objChrt = ActiveSheet.ChartObjects(11) Set myChart = objChrt.Chart myFileName = ActiveWorkbook.Name & " " & "S33.JPEG" On Error Resume Next Kill ActiveWorkbook.Path & "\" & myFileName On Error GoTo 0 myChart.Export Filename:=ActiveWorkbook.Path & "\" & myFileName, Filtername:="JPEG" Set objChrt = ActiveSheet.ChartObjects(12) Set myChart = objChrt.Chart myFileName = ActiveWorkbook.Name & " " & "S34.JPEG" On Error Resume Next Kill ActiveWorkbook.Path & "\" & myFileName On Error GoTo 0 myChart.Export Filename:=ActiveWorkbook.Path & "\" & myFileName, Filtername:="JPEG" Set objChrt = ActiveSheet.ChartObjects(13) Set myChart = objChrt.Chart myFileName = ActiveWorkbook.Name & " " & "S41.JPEG" On Error Resume Next Kill ActiveWorkbook.Path & "\" & myFileName On Error GoTo 0 myChart.Export Filename:=ActiveWorkbook.Path & "\" & myFileName, Filtername:="JPEG" Set objChrt = ActiveSheet.ChartObjects(14) Set myChart = objChrt.Chart myFileName = ActiveWorkbook.Name & " " & "S42.JPEG" On Error Resume Next Kill ActiveWorkbook.Path & "\" & myFileName On Error GoTo 0 myChart.Export Filename:=ActiveWorkbook.Path & "\" & myFileName, Filtername:="JPEG" Set objChrt = ActiveSheet.ChartObjects(15) Set myChart = objChrt.Chart myFileName = ActiveWorkbook.Name & " " & "S43.JPEG" On Error Resume Next Kill ActiveWorkbook.Path & "\" & myFileName On Error GoTo 0 myChart.Export Filename:=ActiveWorkbook.Path & "\" & myFileName, Filtername:="JPEG" Set objChrt = ActiveSheet.ChartObjects(16) Set myChart = objChrt.Chart myFileName = ActiveWorkbook.Name & " " & "S44.JPEG" On Error Resume Next Kill ActiveWorkbook.Path & "\" & myFileName On Error GoTo 0 myChart.Export Filename:=ActiveWorkbook.Path & "\" & myFileName, Filtername:="JPEG" MsgBox "OK" End Sub
你的第一个子有556行代码只是为了创build16个图表。 这是编写代码最低效的方式。 试想一下，如果你将不得不创build100个图表？
您的代码可以汇总为大约60行。
逻辑：
- 使用循环来创build一个图表。
- 查看模式并为其分配variables。 例如
Chart.Left或Chart.Name或.SeriesCollection(1).Name或.SeriesCollection(1).Values等 - 我没有使用
Application.ScreenUpdating = False。 你也可以使用它来提高代码的速度。
代码：（UNTESTED）
Sub Export() Dim objChrt As ChartObject Dim myChart As Chart Dim sh As Worksheet Dim startCol As Long, ChrtNo As Long, lftChart As Long Dim ColName As String ThisWorkbook.Sheets(1).Name = "Sheet1" Set sh = ThisWorkbook.Sheets(1) strtCol = 3 '<~~ Col C ChrtNo = 11 lftChart = 1700 For i = 1 To 16 Set mychrt = sh.Shapes.AddChart.Chart ColName = Split(sh.Cells(, strtCol).Address, "$")(1) With mychrt ' Chart type and source selection .ChartType = xlXYScatterSmoothNoMarkers .SeriesCollection.NewSeries .SeriesCollection(1).Name = "=Sheet1!$" & ColName & "$5" .SeriesCollection(1).XValues = "=Sheet1!$B$807:$B$1006" .SeriesCollection(1).Values = "=Sheet1!$" & ColName & "$807:$" & ColName & "$1006" ' Color .SeriesCollection(1).Border.ColorIndex = 43 'change to suit (Green) ' Titles .Axes(xlValue, xlPrimary).HasTitle = True .Axes(xlValue, xlPrimary).AxisTitle.Text = "Gain(dB)" .Axes(xlCategory, xlPrimary).HasTitle = True .Axes(xlCategory, xlPrimary).AxisTitle.Text = "Frequency (Hz)" .HasTitle = True .ChartTitle.Text = "S" & ChrtNo ' Scale settings .Axes(xlCategory).Select .Axes(xlCategory).MinimumScale = 2400000000# .Axes(xlCategory).MaximumScale = 2500000000# .Axes(xlCategory).HasMajorGridlines = True Selection.TickLabelPosition = xlLow .Axes(xlValue).Select .Axes(xlValue).MinimumScale = -40 .Axes(xlValue).MaximumScale = 0 .Axes(xlValue).HasMajorGridlines = True ' Position and size .ChartArea.Top = 10 .ChartArea.Left = lftChart .ChartArea.Height = 400 .ChartArea.Width = 750 End With strtCol = strtCol + 2 ChrtNo = ChrtNo + 1 lftChart = lftChart + 760 Next End Sub