绘制二维折线图

 从B6 C6 D6开始选中3列数据绘制二维折线图。

Sub DrawLineChart()
    Dim ws As Worksheet
    Dim LastRow As Long
    Dim ChartObj As ChartObject
    Dim ChartRange As Range
    Dim SheetName As String
    Dim ChartTitle As String
    Dim FirstUnderscorePos As Long
    Dim SecondUnderscorePos As Long
    
    ' 指定当前工作表
    Set ws = ActiveSheet
    
    ' 找到最后一行数据
    LastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
    
    ' 定义数据区域：从 B6 到 D 最后一行
    Set ChartRange = ws.Range("B6:D" & LastRow)
    
    ' 获取工作表名称
    SheetName = ws.Name
    
    ' 查找第一个下划线的位置
    FirstUnderscorePos = InStr(1, SheetName, "_")
    
    ' 查找第二个下划线的位置
    SecondUnderscorePos = InStr(FirstUnderscorePos + 1, SheetName, "_")
    
    ' 如果找到第二个下划线，则截取第一个到第二个下划线之间的内容
    If SecondUnderscorePos > 0 Then
        ChartTitle = Left(SheetName, SecondUnderscorePos - 1)
    Else
        ' 如果没有第二个下划线，则使用整个工作表名称
        ChartTitle = SheetName
    End If
    
    ' 删除已有的折线图（避免重复）
    For Each ChartObj In ws.ChartObjects
        ChartObj.Delete
    Next ChartObj
    
    ' 添加一个新的折线图
    Set ChartObj = ws.ChartObjects.Add(Left:=ws.Range("G5").Left, _
                                      Top:=ws.Range("G5").Top, _
                                      Width:=ws.Range("S32").Left - ws.Range("G5").Left, _
                                      Height:=ws.Range("S32").Top - ws.Range("G5").Top)
    
    ' 设置折线图数据
    With ChartObj.Chart
        .SetSourceData Source:=ChartRange
        .ChartType = xlLine ' 设置图表类型为折线图
        .HasTitle = True
        .ChartTitle.Text = ChartTitle ' 设置图表标题为工作表名称的第二个下划线前的内容
        
        ' 设置标签位置为低位置
        .Axes(xlCategory, xlPrimary).TickLabelPosition = xlLow
        
        ' 调整折线宽度，匹配手动效果
        Dim srs As Series
        For Each srs In .SeriesCollection
            srs.Format.Line.Weight = 2.25 ' 设置线条宽度为2.25，接近手动绘制效果
        Next srs
        
        ' 修改坐标轴旁边的数字标签颜色为灰色
        With .Axes(xlCategory, xlPrimary).TickLabels.Font
            .Color = RGB(128, 128, 128)
        End With
        With .Axes(xlValue, xlPrimary).TickLabels.Font
            .Color = RGB(128, 128, 128)
        End With
        
        ' 修改图表绘图区网格线颜色为浅灰色
        With .Axes(xlValue).MajorGridlines.Format.Line
            .ForeColor.RGB = RGB(200, 200, 200)
            .Weight = 0.75 ' 设置网格线线宽
        End With
        
        ' 确保值为0的网格线没有加粗
        Dim Gridline As LineFormat
        Set Gridline = .Axes(xlValue).MajorGridlines.Format.Line
        If .Axes(xlValue).MajorUnit = 0 Then
            Gridline.Weight = 0.75
        End If
        
        ' 去除坐标轴的刻度线
        .Axes(xlCategory).MajorTickMark = xlNone
        .Axes(xlCategory).MinorTickMark = xlNone
        .Axes(xlValue).MajorTickMark = xlNone
        .Axes(xlValue).MinorTickMark = xlNone
        
        ' 设置图例位置为底部
        .Legend.Position = xlLegendPositionBottom
    End With
    
    MsgBox "折线图已绘制完成！", vbInformation
End Sub