提高速度并缩短excel VBA MACRO的代码

时间：2013-10-21 16:24:39

标签： excel vba excel-vba charts

我在使用VBA时非常新，我编写了一个宏的代码，该宏最初构建了16个图表，然后以.jpeg格式导出图表。 代码并不难理解。 要选择的数据，图表的名称以及工作簿中图表的位置只有一些小的差异。 它基本上几乎相同的代码用于创建图表16次，另外16次用于导出图表。

代码工作正常，但运行大约需要20-30秒。 你对我如何让它跑得更快有什么想法吗？

欢迎任何输入。谢谢你的时间。

创建图表的第一部分 

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

1 个答案:

答案 0 :(得分：1)

您的第一个子代码只有556行代码，只是为了创建16个图表。这是编写代码的最低效方式。想象一下，如果你必须创建100个图表？

您的代码可以大约60行汇总。

逻辑：

  1. 使用循环创建图表。
  2. 查看模式并为其指定变量。例如Chart.Left或Chart.Name或.SeriesCollection(1).Name或.SeriesCollection(1).Values等。
  3. 我没有使用Application.ScreenUpdating = False。您也可以使用它来提高代码的速度。

    4. 代码:(未经测试） 

    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
相关问题
最新问题