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

Question

我对使用 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

score 1 · Accepted Answer

您的第一个子556代码行仅用于创建 16 个图表。这是编写代码效率最低的方式。想象一下，如果您必须创建 100 个图表？

您的代码可以用大约几60行来概括。

逻辑：

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

代码：（未测试）

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

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

1 回答 1

Related

Reference