VBA批量绘制动态化数据图表

Script_Man

已于 2024-03-17 21:44:11 修改

阅读量1.9k

点赞数 24

分类专栏： VBA进阶文章标签： VBA excel 动态绘图自动化经验分享 .net

于 2024-03-17 21:42:36 首次发布

本文链接：https://blog.csdn.net/m0_62872215/article/details/136402586

版权

VBA进阶专栏收录该内容

16 篇文章

订阅专栏

本文介绍了VBA在Excel批量绘图方面的应用。先阐述了Excel图表与数据的关系，即图表框架可独立存在，已知图表形式时可先画框架再填数据源。接着通过实战案例，展示了如何用VBA代码实现动态绘制多个数据的图表，包括导入数据、建立框架、动态更新数据源等步骤。

摘要生成于 C知道，由 DeepSeek-R1 满血版支持，前往体验 >

对于大多数使用的VBA的人来说，处理excel工作簿中批量数据是日常工作中常见的情形，但与此同时，VBA在批量绘图方面同样有简洁快速的特点。

说起Excel画图表，考虑一个问题，excel图表的本质是什么？很多人会不假思索地回答，数据图形化的一种表达形式。是的，excel图表是图表框架加入原始数据形成的，这很容易理解，因为可以在excel不用任何数据就可以绘制excel图表，这表明图表中的框架不依附于数据可以独立存在。

有人可能会好奇，excel绘制图表就直接原始数据插入图表就可以了，为什么要讨论excel图表和数据的关系呢？因为在实际应用中，当已知excel图表形式，即知道要画什么图表，但是不知道原始数据，可以先画出框架，再填入数据源，有固定图表框架这种情况下，有一组新数据就会有一个新图表。

有了以上基础，可以参考以下实战案例：有8个工作簿，每一个工作簿都有若干行和列的数据，行坐标是日期，列坐标是数据项目名称，工作簿中包含有Avg. Best FFL, Avg. Defocus, Avg. DOF, Monitor MT,这四项的列坐标在不同工作簿的位置不一样，现需要在一张工作簿显示这四项最近一个月的数据。

分析以上需求可知，在一页显示8张工作簿的4项需要32张图表才能满足需求，若同时批量画出来必然不美观，此时可考虑动态图表，即点击某张工作簿标题就显示这张工作簿包含的四项内容；又因为需要显示最近一个月的数据，因此数据源需要及时更新，而四张图表则可以通过VBA代码批量搭框架加入数据源画出来。

Step 1: 将原始数据导入到多个空白工作簿作为数据源；

Step 2: 建立空白图表框架，将工作簿的某列数据导入框架得到图表，重复4次即可得到一页4张；

Step 3: 利用列表框动态触发事件，更新数据源可得到新的图表；

具体实现方法如下：


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
'代码块1：这部分代码是利用子模块将多个工作簿数据集中在一张工作簿多个工作表。
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 

Sub Daily_Monitor()
Application.DisplayAlerts = False
Dim wks As Worksheet, wks1 As Worksheet
For Each wks In ThisWorkbook.Sheets
    If wks.Name <> "IMPRO Monitor Summary" And wks.Name <> "Dynamic Summary" Then
    wks.Delete
    End If
Next
Call Iolite_Post
Call Iolite_Pre
Call Quartz_Monitor
Call RADAR2_Monitor
Call Ammolite_Monitor
Call OVM7690_Monitor
Call Garnet_Monitor
Call Spinel_Monitor
For Each wks1 In ThisWorkbook.Sheets
    If wks1.Name <> "IMPRO Monitor Summary" And wks1.Name <> "Ammolite_Pre_04" Then
    wks1.Columns.Hidden = False
    End If
Next
Application.DisplayAlerts = True
End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
'子代码模块：这部分代码是将每一张工作簿的原始数据复制到每一张命名相同的工作表。
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
Sub Iolite_Post()
Dim ws As Worksheet
ChDrive Z
ChDir "Z:\Fab-Transfer\Impro4 Raw-Data\Iolite\DAILY MONITOR\"
pth = "Z:\Fab-Transfer\Impro4 Raw-Data\Iolite\DAILY MONITOR\"
Workbooks.Open (pth & "Iolite Record.xlsx")
For Each ws In ActiveWorkbook.Sheets
    If ws.Name = "CIP4T11-POST-850nm" Then
        ws.Copy after:=Workbooks("IMPRO Monitor Summary.xlsm").Sheets("IMPRO Monitor Summary")
        ThisWorkbook.ActiveSheet.Name = "Iolite_Post_11"
'    ElseIf ws.Name = "CIP4T02" Then
'        ws.Copy after:=Workbooks("IMPRO Monitor Summary.xlsm").Sheets("IMPRO Monitor Summary")
'        ThisWorkbook.ActiveSheet.Name = "Iolite_Post_02"
    End If
Next ws
Workbooks("Iolite Record.xlsx").Close 0
End Sub

Sub Iolite_Pre()
Dim ws1 As Worksheet
ChDrive Z
ChDir "Z:\Fab-Transfer\Impro4 Raw-Data\Iolite\DAILY MONITOR\"
pth = "Z:\Fab-Transfer\Impro4 Raw-Data\Iolite\DAILY MONITOR\"
Workbooks.Open (pth & "Iolite IR850 Record.xlsx")
For Each ws1 In ActiveWorkbook.Sheets
'    If ws1.Name = "CIP4T03" Then
'        ws1.Copy after:=Workbooks("IMPRO Monitor Summary.xlsm").Sheets("IMPRO Monitor Summary")
'        ThisWorkbook.ActiveSheet.Name = "Iolite_Pre_03"
    If ws1.Name = "CIP4T05-PRE" Then
        ws1.Copy after:=Workbooks("IMPRO Monitor Summary.xlsm").Sheets("IMPRO Monitor Summary")
        ThisWorkbook.ActiveSheet.Name = "Iolite_Pre_05"
    ElseIf ws1.Name = "CIP4T08" Then
        ws1.Copy after:=Workbooks("IMPRO Monitor Summary.xlsm").Sheets("IMPRO Monitor Summary")
        ThisWorkbook.ActiveSheet.Name = "Iolite_Pre_08"
    End If
Next ws1
Workbooks("Iolite IR850 Record.xlsx").Close 0
End Sub

Sub Quartz_Monitor()
Dim ws2 As Worksheet
ChDrive Z
ChDir "Z:\Fab-Transfer\Impro4 Raw-Data\Quartz\ENG\Daily Monitor\"
pth = "Z:\Fab-Transfer\Impro4 Raw-Data\Quartz\ENG\Daily Monitor\"
Workbooks.Open (pth & "Quartz Daily Monitor Record-v1.0(CIP4T03).xlsm")
For Each ws2 In ActiveWorkbook.Sheets
    If ws2.Name = "Record" Then
        ws2.Copy after:=Workbooks("IMPRO Monitor Summary.xlsm").Sheets("IMPRO Monitor Summary")
        ThisWorkbook.ActiveSheet.Name = "Quartz_Pre_03"
    End If
Next ws2
Workbooks("Quartz Daily Monitor Record-v1.0(CIP4T03).xlsm").Close 0
End Sub

Sub RADAR2_Monitor()
On Error Resume Next
Dim ws3 As Worksheet, ws4 As Worksheet
ChDrive Z
ChDir "Z:\Fab-Transfer\Impro4 Raw-Data\OVM6211-RADA-R2\DAILY MONITOR\"
pth = "Z:\Fab-Transfer\Impro4 Raw-Data\OVM6211-RADA-R2\DAILY MONITOR\"

Workbooks.Open (pth & "RADA R2 Pre Record.xlsx")
For Each ws3 In ActiveWorkbook.Sheets
    If ws3.Name = "CIP4T10" Then
        ws3.Copy after:=Workbooks("IMPRO Monitor Summary.xlsm").Sheets("IMPRO Monitor Summary")
        ThisWorkbook.ActiveSheet.Name = "RADA-R2_Pre_10"
    End If
Next ws3
Workbooks("RADA R2 Pre Record.xlsx").Close 0

ChDrive Z
ChDir "Z:\Fab-Transfer\Impro4 Raw-Data\OVM6211-RADA-R2\DAILY MONITOR\"
pth = "Z:\Fab-Transfer\Impro4 Raw-Data\OVM6211-RADA-R2\DAILY MONITOR\"
Workbooks.Open (pth & "RADA R2 Post Record.xlsx")

For Each ws4 In ActiveWorkbook.Sheets
    If ws4.Name = "CIP4T02" Then
        ws4.Copy after:=Workbooks("IMPRO Monitor Summary.xlsm").Sheets("IMPRO Monitor Summary")
        ThisWorkbook.ActiveSheet.Name = "RADA-R2_Post_02"
    End If
Next ws4
Workbooks("RADA R2 Post Record.xlsx").Close 0
End Sub


Sub Ammolite_Monitor()
On Error Resume Next
Dim ws5 As Worksheet
ChDrive Z
ChDir "Z:\Fab-Transfer\Impro4 Raw-Data\Ammolite\ENG\Daily Monitor\"
pth = "Z:\Fab-Transfer\Impro4 Raw-Data\Ammolite\ENG\Daily Monitor\"
Workbooks.Open (pth & "Ammolite Daily Monitor Record-v3.1.xlsm")

For Each ws5 In ActiveWorkbook.Sheets
    If ws5.Name = "Record" Then
        ws5.Copy after:=Workbooks("IMPRO Monitor Summary.xlsm").Sheets("IMPRO Monitor Summary")
        ThisWorkbook.ActiveSheet.Name = "Ammolite_Pre_04"
    End If
Next ws5
Workbooks("Ammolite Daily Monitor Record-v3.1.xlsm").Close 0
End Sub


Sub OVM7690_Monitor()
Dim ws6 As Worksheet
ChDrive Z
ChDir "Z:\Fab-Transfer\Impro4 Raw-Data\VMA001\"
pth = "Z:\Fab-Transfer\Impro4 Raw-Data\VMA001\"
Workbooks.Open (pth & "OVM7690 Correlation Result.xlsx")
For Each ws6 In ActiveWorkbook.Sheets
    If ws6.Name = "Monitor Record" Then
        ws6.Copy after:=Workbooks("IMPRO Monitor Summary.xlsm").Sheets("IMPRO Monitor Summary")
        ThisWorkbook.ActiveSheet.Name = "7690_01"
    End If
Next ws6
Workbooks("OVM7690 Correlation Result.xlsx").Close 0
End Sub


Sub Garnet_Monitor()
On Error Resume Next
Dim ws7 As Worksheet, ws9 As Worksheet
ChDrive Z
ChDir "Z:\Fab-Transfer\Impro4 Raw-Data\Garnet\ENG\Daily Monitor\"
pth = "Z:\Fab-Transfer\Impro4 Raw-Data\Garnet\ENG\Daily Monitor\"
Workbooks.Open (pth & "Garnet Daily Monitor Record-CIP4T15 &CIP4T12.xlsm")
For Each ws7 In ActiveWorkbook.Sheets
    If ws7.Name = "Record" Then
        ws7.Copy after:=Workbooks("IMPRO Monitor Summary.xlsm").Sheets("IMPRO Monitor Summary")
        ThisWorkbook.ActiveSheet.Name = "Garnet_Pre_12"
    End If
Next ws7
Workbooks("Garnet Daily Monitor Record-CIP4T15 &CIP4T12.xlsm").Close 0
Workbooks.Open (pth & "Garnet Daily Monitor Record-CIP4T13.xlsm")
For Each ws9 In ActiveWorkbook.Sheets
    If ws9.Name = "Record" Then
        ws9.Copy after:=Workbooks("IMPRO Monitor Summary.xlsm").Sheets("IMPRO Monitor Summary")
        ThisWorkbook.ActiveSheet.Name = "Garnet_Pre_13"
    End If
Next ws9
Workbooks("Garnet Daily Monitor Record-CIP4T13.xlsm").Close 0
End Sub


Sub Spinel_Monitor()
Dim ws8 As Worksheet
ChDrive Z
ChDir "Z:\Fab-Transfer\Impro4 Raw-Data\Spinel\Macro\"
pth = "Z:\Fab-Transfer\Impro4 Raw-Data\Spinel\Macro\"
Workbooks.Open (pth & "Spinel Daily Monitor Record-V2.xlsm")
For Each ws8 In ActiveWorkbook.Sheets
    If ws8.Name = "Record" Then
        ws8.Copy after:=Workbooks("IMPRO Monitor Summary.xlsm").Sheets("IMPRO Monitor Summary")
        ThisWorkbook.ActiveSheet.Name = "Spinel_Pre_14"
    End If
Next ws8
Workbooks("Spinel Daily Monitor Record-V2.xlsm").Close 0
End Sub


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
'代码块2：这部分代码是创建图表框架，然后定义工作簿的数据源，利用ListBox clik事件绘制图表
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
Private Sub ListBox1_Click()
Application.DisplayAlerts = False
Sheets("IMPRO Monitor Summary").ChartObjects.Delete
Dim shp1 As Shape, shp2 As Shape, shp3 As Shape, shp4 As Shape
Dim arr1, arr2, arr3, arr4, arr5, arr6, arr7, arr8
Dim k As Integer, i As Integer
Dim ser As Series, pt As Point
Dim ws As Worksheet
With Sheets("IMPRO Monitor Summary").Shapes
    Set shp1 = .AddChart(xlLineMarkers, 5, 0, 320, 220)
    Set shp2 = .AddChart(xlLineMarkers, 325, 0, 320, 220)
    Set shp3 = .AddChart(xlLineMarkers, 5, 220, 320, 220)
    Set shp4 = .AddChart(xlLineMarkers, 325, 220, 320, 220)
End With

'    Iolite_x = Array("Iolite_Pre_03" Or "Iolite_Pre_05" Or "Iolite_Pre_08")
'    For x = 1 To 3
'    Next
    Select Case ListBox1.Value

    Case "Quartz_Pre_03"
        With shp1.Chart
            .SetSourceData Union(Sheets("Quartz_Pre_03").Range("I1048576").End(xlUp)(-28, 1).Resize(30, 1), _
                Sheets("Quartz_Pre_03").Range("B1048576").End(xlUp)(-28, 1).Resize(30, 1))
            .HasLegend = False
            .HasTitle = True
            .ChartTitle.Text = Sheets("Quartz_Pre_03").Columns("I:I").Range("a2")
            .Axes(xlCategory).CategoryType = xlCategoryScale: .Axes(xlCategory).TickLabelSpacing = 1
            .Axes(xlCategory).TickLabels.Font.Size = 6
            .Axes(xlValue).MinimumScale = -0.005: .Axes(xlValue).MaximumScale = 0.005
        End With
        k = 1
        For Each ser In shp1.Chart.FullSeriesCollection
            For Each pt In ser.Points
                If ser.Values(k) > 0.0025 Or ser.Values(k) < -0.0025 Then
                    pt.Format.Fill.ForeColor.RGB = vbRed                 'RGB(255, 0, 0)
                End If
                k = k + 1
            Next
        Next
        With shp2.Chart
            .SetSourceData Union(Sheets("Quartz_Pre_03").Range("P1048576").End(xlUp)(-28, 1).Resize(30, 1), _
                Sheets("Quartz_Pre_03").Range("B1048576").End(xlUp)(-28, 1).Resize(30, 1))
            .HasLegend = False
            .HasTitle = True
            .ChartTitle.Text = Sheets("Quartz_Pre_03").Columns("P:P").Range("a2")
            .Axes(xlCategory).CategoryType = xlCategoryScale: .Axes(xlCategory).TickLabelSpacing = 1
            .Axes(xlCategory).TickLabels.Font.Size = 6
            .Axes(xlValue).MinimumScale = -0.005: .Axes(xlValue).MaximumScale = 0.005
        End With
        With shp3.Chart
            .SetSourceData Union(Sheets("Quartz_Pre_03").Range("Q1048576").End(xlUp)(-28, 1).Resize(30, 1), _
                Sheets("Quartz_Pre_03").Range("B1048576").End(xlUp)(-28, 1).Resize(30, 1))
            .HasLegend = False
            .HasTitle = True
            .ChartTitle.Text = Sheets("Quartz_Pre_03").Columns("Q:Q").Range("a2")
            .Axes(xlCategory).CategoryType = xlCategoryScale: .Axes(xlCategory).TickLabelSpacing = 1
            .Axes(xlCategory).TickLabels.Font.Size = 6
            .Axes(xlValue).MinimumScale = -0.01: .Axes(xlValue).MaximumScale = 0.01
        End With
        With shp4.Chart
            .SetSourceData Source:=Sheets("Quartz_Pre_03").Range("S1048576").End(xlUp)(-28, 1).Resize(30, 17)
            .Axes(xlValue).MinimumScale = -3: .Axes(xlValue).MaximumScale = 3
            .HasTitle = True
            .ChartTitle.Text = "Monitor MTF"
            .Legend.Position = xlLegendPositionBottom
            .Legend.Font.Size = 6
            .Legend.Height = 30
        End With
        arr1 = Sheets("Quartz_Pre_03").Range("S2:AI2")
'        arr2 = Sheets("Iolite_Pre_03").Range("A1048576").End(xlUp)(-28, 1).Resize(30, 1)
        i = 1
        For Each ser In shp4.Chart.SeriesCollection
            ser.Name = arr1(1, i)
            i = i + 1
        Next
'        j = 1
'        Dim xcht As ChartObject, xser As Series
'        For Each xcht In Sheets("IMPRO Monitor Summary").ChartObjects
'            For Each xser In xcht.Chart.SeriesCollection
'                xser.XValues = arr2(j, 1)
'                j = j + 1
'            Next
'        Next
'        cht.FullSeriesCollection.XValues = arr1
'''    cht1.Chart.Legend.Position = xlLegendPositionBottom
        
    Case "Iolite_Pre_05"
        With shp1.Chart
            .SetSourceData Union(Sheets("Iolite_Pre_05").Range("L1048576").End(xlUp)(-28, 1).Resize(30, 1), _
                Sheets("Iolite_Pre_05").Range("A1048576").End(xlUp)(-28, 1).Resize(30, 1))
            .HasLegend = False
            .HasTitle = True
            .ChartTitle.Text = Sheets("Iolite_Pre_05").Columns("L:L").Range("a2")
            .Axes(xlCategory).CategoryType = xlCategoryScale: .Axes(xlCategory).TickLabelSpacing = 1
            .Axes(xlCategory).TickLabels.Font.Size = 6
            .Axes(xlValue).MinimumScale = -5: .Axes(xlValue).MaximumScale = 5
        End With
        k = 1
        For Each ser In shp1.Chart.FullSeriesCollection
            For Each pt In ser.Points
                If ser.Values(k) > 2.5 Or ser.Values(k) < -2.5 Then
                    pt.Format.Fill.ForeColor.RGB = vbRed                 'RGB(255, 0, 0)
                End If
                k = k + 1
            Next
        Next
        With shp2.Chart
            .SetSourceData Union(Sheets("Iolite_Pre_05").Range("J1048576").End(xlUp)(-28, 1).Resize(30, 1), _
                Sheets("Iolite_Pre_05").Range("A1048576").End(xlUp)(-28, 1).Resize(30, 1))
            .HasLegend = False
            .HasTitle = True
            .ChartTitle.Text = Sheets("Iolite_Pre_05").Columns("J:J").Range("a2")
            .Axes(xlCategory).CategoryType = xlCategoryScale: .Axes(xlCategory).TickLabelSpacing = 1
            .Axes(xlCategory).TickLabels.Font.Size = 6
            .Axes(xlValue).MinimumScale = 0: .Axes(xlValue).MaximumScale = 0.01
        End With
        With shp3.Chart
            .SetSourceData Union(Sheets("Iolite_Pre_05").Range("K1048576").End(xlUp)(-28, 1).Resize(30, 1), _
                Sheets("Iolite_Pre_05").Range("A1048576").End(xlUp)(-28, 1).Resize(30, 1))
            .HasLegend = False
            .HasTitle = True
            .ChartTitle.Text = Sheets("Iolite_Pre_05").Columns("K:K").Range("a2")
            .Axes(xlCategory).CategoryType = xlCategoryScale: .Axes(xlCategory).TickLabelSpacing = 1
            .Axes(xlCategory).TickLabels.Font.Size = 6
            .Axes(xlValue).MinimumScale = 34: .Axes(xlValue).MaximumScale = 44
        End With
        With shp4.Chart
            .SetSourceData Sheets("Iolite_Pre_05").Range("P1048576").End(xlUp)(-28, 1).Resize(30, 17)
            .Axes(xlValue).MinimumScale = -3: .Axes(xlValue).MaximumScale = 3
            .HasTitle = True
            .ChartTitle.Text = "Monitor MTF"
            .Legend.Position = xlLegendPositionBottom
            .Legend.Font.Size = 6
            .Legend.Height = 30
        End With
        arr1 = Sheets("Iolite_Pre_05").Range("P2:AF2")
'        arr2 = Sheets("Iolite_Pre_05").Range("A1048576").End(xlUp)(-28, 1).Resize(30, 1)
        i = 1
        For Each ser In shp4.Chart.SeriesCollection
            ser.Name = arr1(1, i)
            i = i + 1
        Next
        
    Case "Iolite_Pre_08"
        With shp1.Chart
            .SetSourceData Union(Sheets("Iolite_Pre_08").Range("L1048576").End(xlUp)(-28, 1).Resize(30, 1), _
                Sheets("Iolite_Pre_08").Range("A1048576").End(xlUp)(-28, 1).Resize(30, 1))
            .HasLegend = False
            .HasTitle = True
            .ChartTitle.Text = Sheets("Iolite_Pre_08").Columns("L:L").Range("a2")
            .Axes(xlCategory).CategoryType = xlCategoryScale: .Axes(xlCategory).TickLabelSpacing = 1
            .Axes(xlCategory).TickLabels.Font.Size = 6
            .Axes(xlValue).MinimumScale = -5: .Axes(xlValue).MaximumScale = 5
        End With
        k = 1
        For Each ser In shp1.Chart.FullSeriesCollection
            For Each pt In ser.Points
                If ser.Values(k) > 2.5 Or ser.Values(k) < -2.5 Then
                    pt.Format.Fill.ForeColor.RGB = vbRed                 'RGB(255, 0, 0)
                End If
                k = k + 1
            Next
        Next
        With shp2.Chart
            .SetSourceData Union(Sheets("Iolite_Pre_08").Range("J1048576").End(xlUp)(-28, 1).Resize(30, 1), _
                Sheets("Iolite_Pre_08").Range("A1048576").End(xlUp)(-28, 1).Resize(30, 1))
            .HasLegend = False
            .HasTitle = True
            .ChartTitle.Text = Sheets("Iolite_Pre_08").Columns("J:J").Range("a2")
            .Axes(xlCategory).CategoryType = xlCategoryScale: .Axes(xlCategory).TickLabelSpacing = 1
            .Axes(xlCategory).TickLabels.Font.Size = 6
            .Axes(xlValue).MinimumScale = 0: .Axes(xlValue).MaximumScale = 0.01
        End With
        With shp3.Chart
            .SetSourceData Union(Sheets("Iolite_Pre_08").Range("K1048576").End(xlUp)(-28, 1).Resize(30, 1), _
                Sheets("Iolite_Pre_08").Range("A1048576").End(xlUp)(-28, 1).Resize(30, 1))
            .HasLegend = False
            .HasTitle = True
            .ChartTitle.Text = Sheets("Iolite_Pre_08").Columns("K:K").Range("a2")
            .Axes(xlCategory).CategoryType = xlCategoryScale: .Axes(xlCategory).TickLabelSpacing = 1
            .Axes(xlCategory).TickLabels.Font.Size = 6
            .Axes(xlValue).MinimumScale = 34: .Axes(xlValue).MaximumScale = 44
        End With
        With shp4.Chart
            .SetSourceData Sheets("Iolite_Pre_08").Range("P1048576").End(xlUp)(-28, 1).Resize(30, 17)
            .Axes(xlValue).MinimumScale = -3: .Axes(xlValue).MaximumScale = 3
            .HasTitle = True
            .ChartTitle.Text = "Monitor MTF"
            .Legend.Position = xlLegendPositionBottom
            .Legend.Font.Size = 6
            .Legend.Height = 30
        End With
        arr1 = Sheets("Iolite_Pre_08").Range("P2:AF2")
'        arr2 = Sheets("Iolite_Pre_08").Range("A1048576").End(xlUp)(-28, 1).Resize(30, 1)
        i = 1
        For Each ser In shp4.Chart.SeriesCollection
            ser.Name = arr1(1, i)
            i = i + 1
        Next

    Case "RADA-R2_Post_02"
        With shp1.Chart
            .SetSourceData Union(Sheets("RADA-R2_Post_02").Range("B1048576").End(xlUp)(-28, 1).Resize(30, 1), _
                Sheets("RADA-R2_Post_02").Range("A1048576").End(xlUp)(-28, 1).Resize(30, 1))
            .HasLegend = False
            .HasTitle = True
            .ChartTitle.Text = Sheets("RADA-R2_Post_02").Columns("B:B").Range("a2")
            .Axes(xlCategory).CategoryType = xlCategoryScale: .Axes(xlCategory).TickLabelSpacing = 1
            .Axes(xlCategory).TickLabels.Font.Size = 6
            .Axes(xlValue).MinimumScale = -5: .Axes(xlValue).MaximumScale = 5
        End With
        k = 1
        For Each ser In shp1.Chart.FullSeriesCollection
            For Each pt In ser.Points
                If ser.Values(k) > 2 Or ser.Values(k) < -2 Then
                    pt.Format.Fill.ForeColor.RGB = vbRed                 'RGB(255, 0, 0)
                End If
                k = k + 1
            Next
        Next
        With shp2.Chart
            .SetSourceData Union(Sheets("RADA-R2_Post_02").Range("C1048576").End(xlUp)(-28, 1).Resize(30, 1), _
                Sheets("RADA-R2_Post_02").Range("A1048576").End(xlUp)(-28, 1).Resize(30, 1))
            .HasLegend = False
            .HasTitle = True
            .ChartTitle.Text = Sheets("RADA-R2_Post_02").Columns("C:C").Range("a2")
            .Axes(xlCategory).CategoryType = xlCategoryScale: .Axes(xlCategory).TickLabelSpacing = 1
            .Axes(xlCategory).TickLabels.Font.Size = 6
            .Axes(xlValue).MinimumScale = -5: .Axes(xlValue).MaximumScale = 5
        End With
        With shp3.Chart
            .SetSourceData Union(Sheets("RADA-R2_Post_02").Range("D1048576").End(xlUp)(-28, 1).Resize(30, 1), _
                Sheets("RADA-R2_Post_02").Range("A1048576").End(xlUp)(-28, 1).Resize(30, 1))
            .HasLegend = False
            .HasTitle = True
            .ChartTitle.Text = Sheets("RADA-R2_Post_02").Columns("D:D").Range("a2")
            .Axes(xlCategory).CategoryType = xlCategoryScale: .Axes(xlCategory).TickLabelSpacing = 1
            .Axes(xlCategory).TickLabels.Font.Size = 6
            .Axes(xlValue).MinimumScale = -5: .Axes(xlValue).MaximumScale = 5
        End With
        k = 1
        For Each ser In shp3.Chart.FullSeriesCollection
            For Each pt In ser.Points
                If ser.Values(k) > 5 Or ser.Values(k) < -10 Then
                    pt.Format.Fill.ForeColor.RGB = vbRed                 'RGB(255, 0, 0)
                End If
                k = k + 1
            Next
        Next
        With shp4.Chart
            .SetSourceData Union(Sheets("RADA-R2_Post_02").Range("E2:I2"), Sheets("RADA-R2_Post_02").Range("E1048576").End(xlUp)(-28, 1).Resize(30, 5))
            .Axes(xlValue).MinimumScale = 0.26: .Axes(xlValue).MaximumScale = 0.31
            .HasTitle = True
            .ChartTitle.Text = "Post FFL In Different Field"
            .Legend.Position = xlLegendPositionBottom
            .Legend.Font.Size = 6
            .Legend.Height = 30
        End With

    Case "Iolite_Post_11"
        With shp1.Chart
            .SetSourceData Union(Sheets("Iolite_Post_11").Range("C1048576").End(xlUp)(-28, 1).Resize(30, 1), _
                Sheets("Iolite_Post_11").Range("A1048576").End(xlUp)(-28, 1).Resize(30, 1))
            .HasLegend = False
            .HasTitle = True
            .ChartTitle.Text = Sheets("Iolite_Post_11").Columns("C:C").Range("a2")
            .Axes(xlCategory).CategoryType = xlCategoryScale: .Axes(xlCategory).TickLabelSpacing = 1
            .Axes(xlCategory).TickLabels.Font.Size = 6
            .Axes(xlValue).MinimumScale = -5: .Axes(xlValue).MaximumScale = 5
        End With
        k = 1
        For Each ser In shp1.Chart.FullSeriesCollection
            For Each pt In ser.Points
                If ser.Values(k) > 2 Or ser.Values(k) < -2 Then
                    pt.Format.Fill.ForeColor.RGB = vbRed                 'RGB(255, 0, 0)
                End If
                k = k + 1
            Next
        Next
        With shp2.Chart
            .SetSourceData Union(Sheets("Iolite_Post_11").Range("D1048576").End(xlUp)(-28, 1).Resize(30, 1), _
                Sheets("Iolite_Post_11").Range("A1048576").End(xlUp)(-28, 1).Resize(30, 1))
            .HasLegend = False
            .HasTitle = True
            .ChartTitle.Text = Sheets("Iolite_Post_11").Columns("D:D").Range("a2")
            .Axes(xlCategory).CategoryType = xlCategoryScale: .Axes(xlCategory).TickLabelSpacing = 1
            .Axes(xlCategory).TickLabels.Font.Size = 6
            .Axes(xlValue).MinimumScale = -5: .Axes(xlValue).MaximumScale = 5
        End With
        With shp3.Chart
            .SetSourceData Union(Sheets("Iolite_Post_11").Range("E1048576").End(xlUp)(-28, 1).Resize(30, 1), _
                Sheets("Iolite_Post_11").Range("A1048576").End(xlUp)(-28, 1).Resize(30, 1))
            .HasLegend = False
            .HasTitle = True
            .ChartTitle.Text = Sheets("Iolite_Post_11").Columns("E:E").Range("a2")
            .Axes(xlCategory).CategoryType = xlCategoryScale: .Axes(xlCategory).TickLabelSpacing = 1
            .Axes(xlCategory).TickLabels.Font.Size = 6
            .Axes(xlValue).MinimumScale = -10: .Axes(xlValue).MaximumScale = 0
        End With
        k = 1
        For Each ser In shp3.Chart.FullSeriesCollection
            For Each pt In ser.Points
                If ser.Values(k) > 5 Or ser.Values(k) < -10 Then
                    pt.Format.Fill.ForeColor.RGB = vbRed                 'RGB(255, 0, 0)
                End If
                k = k + 1
            Next
        Next
        With shp4.Chart
            .SetSourceData Union(Sheets("Iolite_Post_11").Range("F2:J2"), Sheets("Iolite_Post_11").Range("F1048576").End(xlUp)(-28, 1).Resize(30, 5))
            .Axes(xlValue).MinimumScale = 0.22: .Axes(xlValue).MaximumScale = 0.27
            .HasTitle = True
            .ChartTitle.Text = "Post FFL In Different Field"
            .Legend.Position = xlLegendPositionBottom
            .Legend.Font.Size = 6
            .Legend.Height = 30
        End With
        
'    Case "Ruby2_Post_16"
'        With shp1.Chart
'            .SetSourceData Union(Sheets("Ruby2_Post_16").Range("B1048576").End(xlUp)(-28, 1).Resize(30, 1), _
'                Sheets("Ruby2_Post_16").Range("A1048576").End(xlUp)(-28, 1).Resize(30, 1))
'            .HasLegend = False
'            .HasTitle = True
'            .ChartTitle.Text = Sheets("Ruby2_Post_16").Columns("B:B").Range("a2")
'            .Axes(xlCategory).CategoryType = xlCategoryScale: .Axes(xlCategory).TickLabelSpacing = 1
'            .Axes(xlCategory).TickLabels.Font.Size = 6
'            .Axes(xlValue).MinimumScale = -5: .Axes(xlValue).MaximumScale = 5
'        End With
'        k = 1
'        For Each ser In shp1.Chart.FullSeriesCollection
'            For Each pt In ser.Points
'                If ser.Values(k) > 2.5 Or ser.Values(k) < -2.5 Then
'                    pt.Format.Fill.ForeColor.RGB = vbRed                 'RGB(255, 0, 0)
'                End If
'                k = k + 1
'            Next
'        Next
'        With shp2.Chart
'            .SetSourceData Union(Sheets("Ruby2_Post_16").Range("C1048576").End(xlUp)(-28, 1).Resize(30, 1), _
'                Sheets("Ruby2_Post_16").Range("A1048576").End(xlUp)(-28, 1).Resize(30, 1))
'            .HasLegend = False
'            .HasTitle = True
'            .ChartTitle.Text = Sheets("Ruby2_Post_16").Columns("C:C").Range("a2")
'            .Axes(xlCategory).CategoryType = xlCategoryScale: .Axes(xlCategory).TickLabelSpacing = 1
'            .Axes(xlCategory).TickLabels.Font.Size = 6
'            .Axes(xlValue).MinimumScale = -5: .Axes(xlValue).MaximumScale = 5
'        End With
'        With shp3.Chart
'            .SetSourceData Union(Sheets("Ruby2_Post_16").Range("D1048576").End(xlUp)(-28, 1).Resize(30, 1), _
'                Sheets("Ruby2_Post_16").Range("A1048576").End(xlUp)(-28, 1).Resize(30, 1))
'            .HasLegend = False
'            .HasTitle = True
'            .ChartTitle.Text = Sheets("Ruby2_Post_16").Columns("D:D").Range("a2")
'            .Axes(xlCategory).CategoryType = xlCategoryScale: .Axes(xlCategory).TickLabelSpacing = 1
'            .Axes(xlCategory).TickLabels.Font.Size = 6
'            .Axes(xlValue).MinimumScale = 0: .Axes(xlValue).MaximumScale = 10
'        End With
'        k = 1
'        For Each ser In shp3.Chart.FullSeriesCollection
'            For Each pt In ser.Points
'                If ser.Values(k) > 5 Then
'                    pt.Format.Fill.ForeColor.RGB = vbRed                 'RGB(255, 0, 0)
'                End If
'                k = k + 1
'            Next
'        Next
'        With shp4.Chart
'            .SetSourceData Union(Sheets("Ruby2_Post_16").Range("E2:I2"), Sheets("Ruby2_Post_16").Range("E1048576").End(xlUp)(-28, 1).Resize(30, 5))
'            .Axes(xlValue).MinimumScale = 0.265: .Axes(xlValue).MaximumScale = 0.295
'            .HasTitle = True
'            .ChartTitle.Text = "Post FFL In Different Field"
'            .Legend.Position = xlLegendPositionBottom
'            .Legend.Font.Size = 6
'            .Legend.Height = 30
'        End With
'
'    Case "Ruby2_Pre_06"
'        With shp1.Chart
'            .SetSourceData Union(Sheets("Ruby2_Pre_06").Range("L1048576").End(xlUp)(-28, 1).Resize(30, 1), _
'                Sheets("Ruby2_Pre_06").Range("A1048576").End(xlUp)(-28, 1).Resize(30, 1))
'            .HasLegend = False
'            .HasTitle = True
'            .ChartTitle.Text = Sheets("Ruby2_Pre_06").Columns("L:L").Range("a2")
'            .Axes(xlCategory).CategoryType = xlCategoryScale: .Axes(xlCategory).TickLabelSpacing = 1
'            .Axes(xlCategory).TickLabels.Font.Size = 6
'            .Axes(xlValue).MinimumScale = -5: .Axes(xlValue).MaximumScale = 5
'        End With
'        k = 1
'        For Each ser In shp1.Chart.FullSeriesCollection
'            For Each pt In ser.Points
'                If ser.Values(k) > 2.5 Or ser.Values(k) < -2.5 Then
'                    pt.Format.Fill.ForeColor.RGB = vbRed                 'RGB(255, 0, 0)
'                End If
'                k = k + 1
'            Next
'        Next
'        With shp2.Chart
'            .SetSourceData Union(Sheets("Ruby2_Pre_06").Range("J1048576").End(xlUp)(-28, 1).Resize(30, 1), _
'                Sheets("Ruby2_Pre_06").Range("A1048576").End(xlUp)(-28, 1).Resize(30, 1))
'            .HasLegend = False
'            .HasTitle = True
'            .ChartTitle.Text = Sheets("Ruby2_Pre_06").Columns("J:J").Range("a2")
'            .Axes(xlCategory).CategoryType = xlCategoryScale: .Axes(xlCategory).TickLabelSpacing = 1
'            .Axes(xlCategory).TickLabels.Font.Size = 6
'            .Axes(xlValue).MinimumScale = -0.01: .Axes(xlValue).MaximumScale = 0
'        End With
'        With shp3.Chart
'            .SetSourceData Union(Sheets("Ruby2_Pre_06").Range("K1048576").End(xlUp)(-28, 1).Resize(30, 1), _
'                Sheets("Ruby2_Pre_06").Range("A1048576").End(xlUp)(-28, 1).Resize(30, 1))
'            .HasLegend = False
'            .HasTitle = True
'            .ChartTitle.Text = Sheets("Ruby2_Pre_06").Columns("K:K").Range("a2")
'            .Axes(xlCategory).CategoryType = xlCategoryScale: .Axes(xlCategory).TickLabelSpacing = 1
'            .Axes(xlCategory).TickLabels.Font.Size = 6
'            .Axes(xlValue).MinimumScale = 45: .Axes(xlValue).MaximumScale = 55
'        End With
'        With shp4.Chart
'            .SetSourceData Sheets("Ruby2_Pre_06").Range("P1048576").End(xlUp)(-28, 1).Resize(30, 17)
'            .Axes(xlValue).MinimumScale = -3: .Axes(xlValue).MaximumScale = 3
'            .HasTitle = True
'            .ChartTitle.Text = "Monitor MTF"
'            .Legend.Position = xlLegendPositionBottom
'            .Legend.Font.Size = 6
'            .Legend.Height = 30
'        End With
'        arr1 = Sheets("Ruby2_Pre_06").Range("P2:AF2")
''        arr2 = Sheets("Ruby2_Pre_06").Range("A1048576").End(xlUp)(-28, 1).Resize(30, 1)
'        i = 1
'        For Each ser In shp4.Chart.SeriesCollection
'            ser.Name = arr1(1, i)
'            i = i + 1
'        Next

    Case "RADA-R2_Pre_10"
        With shp1.Chart
            .SetSourceData Union(Sheets("RADA-R2_Pre_10").Range("L1048576").End(xlUp)(-13, 1).Resize(15, 1), _
                Sheets("RADA-R2_Pre_10").Range("A1048576").End(xlUp)(-13, 1).Resize(15, 1))
            .HasLegend = False
            .HasTitle = True
            .ChartTitle.Text = Sheets("RADA-R2_Pre_10").Columns("L:L").Range("a2")
            .Axes(xlCategory).CategoryType = xlCategoryScale: .Axes(xlCategory).TickLabelSpacing = 1
            .Axes(xlCategory).TickLabels.Font.Size = 6
            .Axes(xlValue).MinimumScale = -5: .Axes(xlValue).MaximumScale = 5
        End With
        k = 1
        For Each ser In shp1.Chart.FullSeriesCollection
            For Each pt In ser.Points
                If ser.Values(k) > 3 Or ser.Values(k) < -3 Then
                    pt.Format.Fill.ForeColor.RGB = vbRed                 'RGB(255, 0, 0)
                End If
                k = k + 1
            Next
        Next
        With shp2.Chart
            .SetSourceData Union(Sheets("RADA-R2_Pre_10").Range("J1048576").End(xlUp)(-13, 1).Resize(15, 1), _
                Sheets("RADA-R2_Pre_10").Range("A1048576").End(xlUp)(-13, 1).Resize(15, 1))
            .HasLegend = False
            .HasTitle = True
            .ChartTitle.Text = Sheets("RADA-R2_Pre_10").Columns("J:J").Range("a2")
            .Axes(xlCategory).CategoryType = xlCategoryScale: .Axes(xlCategory).TickLabelSpacing = 1
            .Axes(xlCategory).TickLabels.Font.Size = 6
            .Axes(xlValue).MinimumScale = -0.005: .Axes(xlValue).MaximumScale = 0.005
        End With
        With shp3.Chart
            .SetSourceData Union(Sheets("RADA-R2_Pre_10").Range("K1048576").End(xlUp)(-13, 1).Resize(15, 1), _
                Sheets("RADA-R2_Pre_10").Range("A1048576").End(xlUp)(-13, 1).Resize(15, 1))
            .HasLegend = False
            .HasTitle = True
            .ChartTitle.Text = Sheets("RADA-R2_Pre_10").Columns("K:K").Range("a2")
            .Axes(xlCategory).CategoryType = xlCategoryScale: .Axes(xlCategory).TickLabelSpacing = 1
            .Axes(xlCategory).TickLabels.Font.Size = 6
            .Axes(xlValue).MinimumScale = 25: .Axes(xlValue).MaximumScale = 30
        End With
        With shp4.Chart
            .SetSourceData Sheets("RADA-R2_Pre_10").Range("P1048576").End(xlUp)(-13, 1).Resize(15, 17)
            .Axes(xlValue).MinimumScale = -3: .Axes(xlValue).MaximumScale = 3
            .HasTitle = True
            .ChartTitle.Text = "Monitor MTF"
            .Legend.Position = xlLegendPositionBottom
            .Legend.Font.Size = 6
            .Legend.Height = 30
        End With
        arr1 = Sheets("RADA-R2_Pre_10").Range("P2:AF2")
'        arr2 = Sheets("RASA_Pre_10").Range("A1048576").End(xlUp)(-28, 1).Resize(30, 1)
        i = 1
        For Each ser In shp4.Chart.SeriesCollection
            ser.Name = arr1(1, i)
            i = i + 1
        Next
        
'    Case "RASA_Pre_09"
'        With shp1.Chart
'            .SetSourceData Union(Sheets("RASA_Pre_09").Range("T1048576").End(xlUp)(-28, 1).Resize(30, 1), _
'                Sheets("RASA_Pre_09").Range("B1048576").End(xlUp)(-28, 1).Resize(30, 1))
'            .HasLegend = False
'            .HasTitle = True
'            .ChartTitle.Text = Sheets("RASA_Pre_09").Columns("T:T").Range("a1")
'            .Axes(xlCategory).CategoryType = xlCategoryScale: .Axes(xlCategory).TickLabelSpacing = 1
'            .Axes(xlCategory).TickLabels.Font.Size = 6
'            .Axes(xlValue).MinimumScale = -0.005: .Axes(xlValue).MaximumScale = 0.005
'        End With
'        k = 1
'        For Each ser In shp1.Chart.FullSeriesCollection
'            For Each pt In ser.Points
'                If ser.Values(k) > 0.003 Or ser.Values(k) < -0.003 Then
'                    pt.Format.Fill.ForeColor.RGB = vbRed                 'RGB(255, 0, 0)
'                End If
'                k = k + 1
'            Next
'        Next
'        With shp2.Chart
'            .SetSourceData Union(Sheets("RASA_Pre_09").Range("AA1048576").End(xlUp)(-28, 1).Resize(30, 1), _
'                Sheets("RASA_Pre_09").Range("B1048576").End(xlUp)(-28, 1).Resize(30, 1))
'            .HasLegend = False
'            .HasTitle = True
'            .ChartTitle.Text = Sheets("RASA_Pre_09").Columns("AA:AA").Range("a1")
'            .Axes(xlCategory).CategoryType = xlCategoryScale: .Axes(xlCategory).TickLabelSpacing = 1
'            .Axes(xlCategory).TickLabels.Font.Size = 6
'            .Axes(xlValue).MinimumScale = -0.005: .Axes(xlValue).MaximumScale = 0.005
'        End With
'        With shp3.Chart
'            .SetSourceData Union(Sheets("RASA_Pre_09").Range("AB1048576").End(xlUp)(-28, 1).Resize(30, 1), _
'                Sheets("RASA_Pre_09").Range("B1048576").End(xlUp)(-28, 1).Resize(30, 1))
'            .HasLegend = False
'            .HasTitle = True
'            .ChartTitle.Text = Sheets("RASA_Pre_09").Columns("AB:AB").Range("a1")
'            .Axes(xlCategory).CategoryType = xlCategoryScale: .Axes(xlCategory).TickLabelSpacing = 1
'            .Axes(xlCategory).TickLabels.Font.Size = 6
'            .Axes(xlValue).MinimumScale = -0.005: .Axes(xlValue).MaximumScale = 0.005
'        End With
'        With shp4.Chart
'            .SetSourceData Sheets("RASA_Pre_09").Range("AD1048576").End(xlUp)(-28, 1).Resize(30, 17)
'            .Axes(xlValue).MinimumScale = -3: .Axes(xlValue).MaximumScale = 3
'            .HasTitle = True
'            .ChartTitle.Text = "Monitor MTF"
'            .Legend.Position = xlLegendPositionBottom
'            .Legend.Font.Size = 6
'            .Legend.Height = 30
'        End With
'        arr1 = Sheets("RASA_Pre_09").Range("AD1:AT1")
''        arr2 = Sheets("RASA_Pre_09").Range("A1048576").End(xlUp)(-28, 1).Resize(30, 1)
'        i = 1
'        For Each ser In shp4.Chart.SeriesCollection
'            ser.Name = arr1(1, i)
'            i = i + 1
'        Next
        
    Case "Garnet_Pre_12"
        With shp1.Chart
            .SetSourceData Union(Sheets("Garnet_Pre_12").Range("I1048576").End(xlUp)(-28, 1).Resize(30, 1), _
                Sheets("Garnet_Pre_12").Range("B1048576").End(xlUp)(-28, 1).Resize(30, 1))
            .HasLegend = False
            .HasTitle = True
            .ChartTitle.Text = Sheets("Garnet_Pre_12").Columns("I:I").Range("a2")
            .Axes(xlCategory).CategoryType = xlCategoryScale: .Axes(xlCategory).TickLabelSpacing = 1
            .Axes(xlCategory).TickLabels.Font.Size = 6
            .Axes(xlValue).MinimumScale = -0.01: .Axes(xlValue).MaximumScale = 0.01
        End With
        k = 1
        For Each ser In shp1.Chart.FullSeriesCollection
            For Each pt In ser.Points
                If ser.Values(k) > 0.003 Or ser.Values(k) < -0.003 Then
                    pt.Format.Fill.ForeColor.RGB = vbRed                 'RGB(255, 0, 0)
                End If
                k = k + 1
            Next
        Next
        With shp2.Chart
            .SetSourceData Union(Sheets("Garnet_Pre_12").Range("P1048576").End(xlUp)(-28, 1).Resize(30, 1), _
                Sheets("Garnet_Pre_12").Range("B1048576").End(xlUp)(-28, 1).Resize(30, 1))
            .HasLegend = False
            .HasTitle = True
            .ChartTitle.Text = Sheets("Garnet_Pre_12").Columns("P:P").Range("a2")
            .Axes(xlCategory).CategoryType = xlCategoryScale: .Axes(xlCategory).TickLabelSpacing = 1
            .Axes(xlCategory).TickLabels.Font.Size = 6
            .Axes(xlValue).MinimumScale = -0.005: .Axes(xlValue).MaximumScale = 0.005
        End With
        With shp3.Chart
            .SetSourceData Union(Sheets("Garnet_Pre_12").Range("Q1048576").End(xlUp)(-28, 1).Resize(30, 1), _
                Sheets("Garnet_Pre_12").Range("B1048576").End(xlUp)(-28, 1).Resize(30, 1))
            .HasLegend = False
            .HasTitle = True
            .ChartTitle.Text = Sheets("Garnet_Pre_12").Columns("Q:Q").Range("a2")
            .Axes(xlCategory).CategoryType = xlCategoryScale: .Axes(xlCategory).TickLabelSpacing = 1
            .Axes(xlCategory).TickLabels.Font.Size = 6
            .Axes(xlValue).MinimumScale = -0.01: .Axes(xlValue).MaximumScale = 0.01
        End With
        With shp4.Chart
            .SetSourceData Sheets("Garnet_Pre_12").Range("S1048576").End(xlUp)(-28, 1).Resize(30, 17)
            .Axes(xlValue).MinimumScale = -5: .Axes(xlValue).MaximumScale = 5
            .HasTitle = True
            .ChartTitle.Text = "Monitor MTF"
            .Legend.Position = xlLegendPositionBottom
            .Legend.Font.Size = 6
            .Legend.Height = 30
        End With
        arr1 = Sheets("Garnet_Pre_12").Range("S2:AI2")
'        arr2 = Sheets("Garnet_Pre_12").Range("A1048576").End(xlUp)(-28, 1).Resize(30, 1)
        i = 1
        For Each ser In shp4.Chart.SeriesCollection
            ser.Name = arr1(1, i)
            i = i + 1
        Next
        
    Case "Garnet_Pre_13"
        With shp1.Chart
            .SetSourceData Union(Sheets("Garnet_Pre_13").Range("T1048576").End(xlUp)(-28, 1).Resize(30, 1), _
                Sheets("Garnet_Pre_13").Range("B1048576").End(xlUp)(-28, 1).Resize(30, 1))
            .HasLegend = False
            .HasTitle = True
            .ChartTitle.Text = Sheets("Garnet_Pre_13").Columns("T:T").Range("a1")
            .Axes(xlCategory).CategoryType = xlCategoryScale: .Axes(xlCategory).TickLabelSpacing = 1
            .Axes(xlCategory).TickLabels.Font.Size = 6
            .Axes(xlValue).MinimumScale = -0.01: .Axes(xlValue).MaximumScale = 0.01
        End With
        k = 1
        For Each ser In shp1.Chart.FullSeriesCollection
            For Each pt In ser.Points
                If ser.Values(k) > 0.003 Or ser.Values(k) < -0.003 Then
                    pt.Format.Fill.ForeColor.RGB = vbRed                 'RGB(255, 0, 0)
                End If
                k = k + 1
            Next
        Next
        With shp2.Chart
            .SetSourceData Union(Sheets("Garnet_Pre_13").Range("AA1048576").End(xlUp)(-28, 1).Resize(30, 1), _
                Sheets("Garnet_Pre_13").Range("B1048576").End(xlUp)(-28, 1).Resize(30, 1))
            .HasLegend = False
            .HasTitle = True
            .ChartTitle.Text = Sheets("Garnet_Pre_13").Columns("AA:AA").Range("a1")
            .Axes(xlCategory).CategoryType = xlCategoryScale: .Axes(xlCategory).TickLabelSpacing = 1
            .Axes(xlCategory).TickLabels.Font.Size = 6
            .Axes(xlValue).MinimumScale = -0.005: .Axes(xlValue).MaximumScale = 0.005
        End With
        With shp3.Chart
            .SetSourceData Union(Sheets("Garnet_Pre_13").Range("AB1048576").End(xlUp)(-28, 1).Resize(30, 1), _
                Sheets("Garnet_Pre_13").Range("B1048576").End(xlUp)(-28, 1).Resize(30, 1))
            .HasLegend = False
            .HasTitle = True
            .ChartTitle.Text = Sheets("Garnet_Pre_13").Columns("AB:AB").Range("a1")
            .Axes(xlCategory).CategoryType = xlCategoryScale: .Axes(xlCategory).TickLabelSpacing = 1
            .Axes(xlCategory).TickLabels.Font.Size = 6
            .Axes(xlValue).MinimumScale = -0.01: .Axes(xlValue).MaximumScale = 0.01
        End With
        With shp4.Chart
            .SetSourceData Sheets("Garnet_Pre_13").Range("AD1048576").End(xlUp)(-28, 1).Resize(30, 17)
            .Axes(xlValue).MinimumScale = -5: .Axes(xlValue).MaximumScale = 5
            .HasTitle = True
            .ChartTitle.Text = "Monitor MTF"
            .Legend.Position = xlLegendPositionBottom
            .Legend.Font.Size = 6
            .Legend.Height = 30
        End With
        arr1 = Sheets("Garnet_Pre_13").Range("AD1:AT1")
'        arr2 = Sheets("Garnet_Pre_12").Range("A1048576").End(xlUp)(-28, 1).Resize(30, 1)
        i = 1
        For Each ser In shp4.Chart.SeriesCollection
            ser.Name = arr1(1, i)
            i = i + 1
        Next
        
        
    Case "Spinel_Pre_14"
        With shp1.Chart
            .SetSourceData Union(Sheets("Spinel_Pre_14").Range("I1048576").End(xlUp)(-28, 1).Resize(30, 1), _
                Sheets("Spinel_Pre_14").Range("B1048576").End(xlUp)(-28, 1).Resize(30, 1))
            .HasLegend = False
            .HasTitle = True
            .ChartTitle.Text = Sheets("Spinel_Pre_14").Columns("I:I").Range("a2")
            .Axes(xlCategory).CategoryType = xlCategoryScale: .Axes(xlCategory).TickLabelSpacing = 1
            .Axes(xlCategory).TickLabels.Font.Size = 6
            .Axes(xlValue).MinimumScale = -0.005: .Axes(xlValue).MaximumScale = 0.005
        End With
        k = 1
        For Each ser In shp1.Chart.FullSeriesCollection
            For Each pt In ser.Points
                If ser.Values(k) > 0.002 Or ser.Values(k) < -0.002 Then
                    pt.Format.Fill.ForeColor.RGB = vbRed                 'RGB(255, 0, 0)
                End If
                k = k + 1
            Next
        Next
        With shp2.Chart
            .SetSourceData Union(Sheets("Spinel_Pre_14").Range("P1048576").End(xlUp)(-28, 1).Resize(30, 1), _
                Sheets("Spinel_Pre_14").Range("B1048576").End(xlUp)(-28, 1).Resize(30, 1))
            .HasLegend = False
            .HasTitle = True
            .ChartTitle.Text = Sheets("Spinel_Pre_14").Columns("P:P").Range("a2")
            .Axes(xlCategory).CategoryType = xlCategoryScale: .Axes(xlCategory).TickLabelSpacing = 1
            .Axes(xlCategory).TickLabels.Font.Size = 6
            .Axes(xlValue).MinimumScale = -0.005: .Axes(xlValue).MaximumScale = 0.005
        End With
        With shp3.Chart
            .SetSourceData Union(Sheets("Spinel_Pre_14").Range("Q1048576").End(xlUp)(-28, 1).Resize(30, 1), _
                Sheets("Spinel_Pre_14").Range("B1048576").End(xlUp)(-28, 1).Resize(30, 1))
            .HasLegend = False
            .HasTitle = True
            .ChartTitle.Text = Sheets("Spinel_Pre_14").Columns("Q:Q").Range("a2")
            .Axes(xlCategory).CategoryType = xlCategoryScale: .Axes(xlCategory).TickLabelSpacing = 1
            .Axes(xlCategory).TickLabels.Font.Size = 6
            .Axes(xlValue).MinimumScale = -0.005: .Axes(xlValue).MaximumScale = 0.005
        End With
        With shp4.Chart
            .SetSourceData Sheets("Spinel_Pre_14").Range("S1048576").End(xlUp)(-28, 1).Resize(30, 17)
            .Axes(xlValue).MinimumScale = -5: .Axes(xlValue).MaximumScale = 5
            .HasTitle = True
            .ChartTitle.Text = "Monitor MTF"
            .Legend.Position = xlLegendPositionBottom
            .Legend.Font.Size = 6
            .Legend.Height = 30
        End With
        arr1 = Sheets("Spinel_Pre_14").Range("S2:AI2")
'        arr2 = Sheets("Garnet_Pre_12").Range("A1048576").End(xlUp)(-28, 1).Resize(30, 1)
        i = 1
        For Each ser In shp4.Chart.SeriesCollection
            ser.Name = arr1(1, i)
            i = i + 1
        Next
        
    Case "Ammolite_Pre_04"
        With shp1.Chart
            .SetSourceData Union(Sheets("Ammolite_Pre_04").Range("T1048576").End(xlUp)(-28, 1).Resize(30, 1), _
                Sheets("Ammolite_Pre_04").Range("B1048576").End(xlUp)(-28, 1).Resize(30, 1))
            .HasLegend = False
            .HasTitle = True
            .ChartTitle.Text = Sheets("Ammolite_Pre_04").Columns("T:T").Range("a1")
            .Axes(xlCategory).CategoryType = xlCategoryScale: .Axes(xlCategory).TickLabelSpacing = 1
            .Axes(xlCategory).TickLabels.Font.Size = 6
            .Axes(xlValue).MinimumScale = -0.005: .Axes(xlValue).MaximumScale = 0.005
        End With
        k = 1
        For Each ser In shp1.Chart.FullSeriesCollection
            For Each pt In ser.Points
                If ser.Values(k) > 0.003 Or ser.Values(k) < -0.003 Then
                    pt.Format.Fill.ForeColor.RGB = vbRed                 'RGB(255, 0, 0)
                End If
                k = k + 1
            Next
        Next
        With shp2.Chart
            .SetSourceData Union(Sheets("Ammolite_Pre_04").Range("AA1048576").End(xlUp)(-28, 1).Resize(30, 1), _
                Sheets("Ammolite_Pre_04").Range("B1048576").End(xlUp)(-28, 1).Resize(30, 1))
            .HasLegend = False
            .HasTitle = True
            .ChartTitle.Text = Sheets("Ammolite_Pre_04").Columns("AA:AA").Range("a1")
            .Axes(xlCategory).CategoryType = xlCategoryScale: .Axes(xlCategory).TickLabelSpacing = 1
            .Axes(xlCategory).TickLabels.Font.Size = 6
            .Axes(xlValue).MinimumScale = -0.005: .Axes(xlValue).MaximumScale = 0.005
        End With
        With shp3.Chart
            .SetSourceData Union(Sheets("Ammolite_Pre_04").Range("AB1048576").End(xlUp)(-28, 1).Resize(30, 1), _
                Sheets("Ammolite_Pre_04").Range("B1048576").End(xlUp)(-28, 1).Resize(30, 1))
            .HasLegend = False
            .HasTitle = True
            .ChartTitle.Text = Sheets("Ammolite_Pre_04").Columns("AB:AB").Range("a1")
            .Axes(xlCategory).CategoryType = xlCategoryScale: .Axes(xlCategory).TickLabelSpacing = 1
            .Axes(xlCategory).TickLabels.Font.Size = 6
            .Axes(xlValue).MinimumScale = -0.005: .Axes(xlValue).MaximumScale = 0.005
        End With
        With shp4.Chart
            Set ws = Sheets("Ammolite_Pre_04")
            n = ws.Rows(1048576).End(xlUp).Row: m = n - 29
            .SetSourceData Union(ws.Range("AD1:AE1"), ws.Range("AD" & m & ":AE" & n), ws.Range("AI1"), _
                ws.Range("AI" & m & ":AI" & n), ws.Range("AM1:AT1"), ws.Range("AM" & m & ":AT" & n))
            .Axes(xlValue).MinimumScale = -5: .Axes(xlValue).MaximumScale = 5
            .HasTitle = True
            .ChartTitle.Text = "Monitor MTF"
            .Legend.Position = xlLegendPositionBottom
            .Legend.Font.Size = 6
            .Legend.Height = 30
        End With

'        arr2 = Sheets("Ammolite_Pre_04").Range("A1048576").End(xlUp)(-28, 1).Resize(30, 1)
'        i = 1
'        For Each ser In shp4.Chart.SeriesCollection
'            ser.Name = arr1(1, i)
'            i = i + 1
'        Next

    Case "7690_01"
        shp1.Delete: shp2.Delete: shp3.Delete
        With shp4.Chart
            .SetSourceData Union(Sheets("7690_01").Range("E1048576").End(xlUp)(-28, 1).Resize(30, 5), Sheets("7690_01").Range("E1:I1"))
            .HasTitle = True
            .ChartTitle.Text = "Monitor MTF"
            .Legend.Position = xlLegendPositionBottom
            .Legend.Font.Size = 6
            .Legend.Height = 30
            .Axes(xlCategory).CategoryType = xlCategoryScale: .Axes(xlCategory).TickLabelSpacing = 1
            .Axes(xlCategory).TickLabels.Font.Size = 6
            .Axes(xlValue).MinimumScale = 44: .Axes(xlValue).MaximumScale = 56
        End With

End Select
Application.DisplayAlerts = True
End Sub


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
'代码块3：这部分代码利用Listbox GotFocus事件切换需要绘制图表的数据源绘制新的图表
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
Private Sub ListBox1_GotFocus()
Dim ar_item
Me.ListBox1.Clear
ar_item = Array("Iolite_Pre_05", "Iolite_Pre_08", "Iolite_Post_11", "Quartz_Pre_03", "RADA-R2_Post_02", "RADA-R2_Pre_10", _
    "Garnet_Pre_12", "Garnet_Pre_13", "Spinel_Pre_14", "Ammolite_Pre_04", "7690_01")
    For x = 0 To UBound(ar_item)
        Me.ListBox1.AddItem ar_item(x)
    Next
'With Me.ListBox1
'    .AddItem "Iolite_Pre_03"
'    .AddItem "Iolite_Pre_05"
'    .AddItem "Iolite_Pre_08"
'    .AddItem "Iolite_Post_02"
'    .AddItem "Iolite_Post_11"
'    .AddItem "Ruby2_Post_16"
'    .AddItem "Ruby2_Pre_06"
'    .AddItem "RASA_Pre_10"
'    .AddItem "RASA_Pre_09"
'    .AddItem "Garnet_Pre_12"
'    .AddItem "Spinel_Pre_14"
'    .AddItem "Ammolite_Pre_04"
'    .AddItem "7690_01"
'End With
End Sub

利用上述代码形成动态图表如下图所示，按钮可以更新数据源，利用滚动条可以动态选择想要查看的数据图表，至于横坐标的日期区间则可以代码动态选择数据源实现，纵坐标的范围则可以代码控制图标坐标轴区间实现。

值得注意的是，代码块1的代码可以写在Excel子模块里面，但是模块2，3的代码则必须写在工作表里面，这是因为触发事件的对象是工作表。
在这里插入图片描述
除此以外，代码变量的声名应该符合规则，或者取消代码强制变量声明；以上代码可以完成动态绘制多个数据的图表，其中，对于图表属性的定义以及触发事件的控制值得参考。