如何修改Excel双线折线图线帽样式 用VBA/VB.NET去除首尾圆角

在Excel中创建折线图并将线条样式设置为双线时，出现下图所示的效果：

可以看到线条的首尾均为圆角样式，希望去除圆角，达到下图所示的效果：

该效果可通过修改线条“cap type（线帽类型）”实现。已尝试查找Series.Format.Line的相关方法和属性，仅能调整首尾箭头，未找到对应线帽的属性或方法；也尝试使用Excel宏录制器暴露该属性/方法，未获成功；还搜索了多个Excel/VBA相关论坛，均未找到有效解决方案。需要VBA和VB.NET两种开发环境下的解决方案。

实现原理 #

Excel公开VBA对象模型未直接暴露线帽类型的操作接口，该属性存储在图表对应的DrawingML标记中，cap属性默认值为rnd（圆角），修改为sq即可得到平角端点效果，我们通过操作图表的XML配置实现该需求。

VBA 实现代码 #

适用范围：Excel 2010及以上版本，仅支持xlsx/xlsm格式未加密工作簿

Sub 更改折线线帽为平角()
    Dim targetChart As Chart
    Dim targetSeries As Series
    Dim chartXmlPart As CustomXMLPart
    Dim xpathStr As String
    
    ' 读取当前选中的图表，可自行替换为指定图表
    Set targetChart = ActiveChart
    If targetChart Is Nothing Then
        MsgBox "请先选中要修改的折线图"
        Exit Sub
    End If
    
    ' 读取第一个系列，可根据需求修改系列索引
    Set targetSeries = targetChart.SeriesCollection(1)
    xpathStr = "//c:ser[c:idx/@val = " & targetSeries.Index - 1 & "]/c:spPr/a:ln/a:cap"
    
    ' 遍历查找图表的绘图XML配置
    For Each chartXmlPart In targetChart.ChartParts(1).CustomXMLParts
        If chartXmlPart.NamespaceURI = "http://schemas.openxmlformats.org/drawingml/2006/chart" Then
            ' 检查cap节点是否存在
            If chartXmlPart.SelectSingleNode(xpathStr) Is Nothing Then
                ' 节点不存在则新增并设置为平角
                chartXmlPart.SelectSingleNode("//c:ser[c:idx/@val = " & targetSeries.Index - 1 & "]/c:spPr/a:ln") _
                    .AppendChildNode "cap", "http://schemas.openxmlformats.org/drawingml/2006/main", "val", "sq"
            Else
                ' 节点存在则直接修改属性
                chartXmlPart.SelectSingleNode(xpathStr).Attributes("val").Text = "sq"
            End If
            Exit For
        End If
    Next
    ' 刷新图表生效
    targetChart.Refresh
End Sub

• 如果需要改回圆角，只需将代码中的"sq"替换为"rnd"即可。

VB.NET 实现代码 #

基于Office Interop + OpenXML SDK实现，需要先引入Microsoft.Office.Interop.Excel和DocumentFormat.OpenXml程序集：

Imports Microsoft.Office.Interop.Excel
Imports DocumentFormat.OpenXml.Packaging
Imports DocumentFormat.OpenXml.Drawing
Imports DocumentFormat.OpenXml.Drawing.Charts

Public Sub SetChartLineCapToSquare(targetChart As Chart, seriesIndex As Integer)
    ' 先保存工作簿确保XML配置已更新
    targetChart.Parent.Parent.Save()
    Dim workbookPath As String = targetChart.Parent.Parent.FullName
    
    ' 用OpenXML修改线帽属性
    Using excelDoc As SpreadsheetDocument = SpreadsheetDocument.Open(workbookPath, True)
        Dim workbookPart As WorkbookPart = excelDoc.WorkbookPart
        Dim chartSheet As Worksheet = targetChart.Parent
        Dim targetSheet As Sheet = workbookPart.Workbook.Descendants(Of Sheet)().First(Function(s) s.Name = chartSheet.Name)
        Dim worksheetPart As WorksheetPart = CType(workbookPart.GetPartById(targetSheet.Id), WorksheetPart)
        Dim targetChartPart As ChartPart = worksheetPart.DrawingsPart.ChartParts(targetChart.Index - 1)
        Dim targetSeries As Series = targetChartPart.ChartSpace.Descendants(Of Series)().ElementAt(seriesIndex - 1)
        Dim lineProp As LineProperties = targetSeries.ShapeProperties.GetFirstChild(Of LineProperties)()
        
        If lineProp IsNot Nothing Then
            Dim capNode As LineCap = lineProp.GetFirstChild(Of LineCap)()
            If capNode Is Nothing Then
                ' 新增平角线帽节点
                lineProp.Append(New LineCap() With {.Val = LineCapValues.Square})
            Else
                ' 修改现有线帽属性为平角
                capNode.Val = LineCapValues.Square
            End If
        End If
        targetChartPart.ChartSpace.Save()
    End Using
    
    ' 重启工作簿刷新显示
    Dim excelApp As Application = targetChart.Application
    targetChart.Parent.Parent.Close(SaveChanges:=False)
    excelApp.Workbooks.Open(workbookPath)
End Sub

• 如果不依赖OpenXML SDK，也可以参考VBA方案直接操作CustomXMLParts修改XML内容实现相同效果。

内容的提问来源于stack exchange，提问作者Rafał Kowalski