【Excel VBA编程】组合图表个性化设计:簇状柱形图+折线图

Sub GenerateReportAndChart()    ' 声明变量    Dim ws As Worksheet    Dim lastRow As Long, i As Long    Dim chartObj As ChartObject    Dim cht As Chart    Dim sngTop As Single, sngLeft As Single    Dim rngData As Range, rngChartData As Range    Dim completionRate As Double    Dim targetSeries As series    On Error GoTo ErrorHandler    '设置工作表对象：当前活动工作表操作    Set ws = ActiveSheet    Application.ScreenUpdating = False    ' 获取数据范围最后一行（假设数据从第2行开始，第1行为标题）    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row    If lastRow < 2 Then        MsgBox "没有找到有效数据！", vbExclamation        Exit Sub    End If    ' 计算差额（D列）和完成率（E列）    For i = 2 To lastRow        If IsNumeric(ws.Cells(i, "C").Value) And IsNumeric(ws.Cells(i, "B").Value) Then            ws.Cells(i, "D").Value = ws.Cells(i, "B").Value - ws.Cells(i, "C").Value        Else            ws.Cells(i, "D").Value = "数据错误"        End If        If IsNumeric(ws.Cells(i, "C").Value) And IsNumeric(ws.Cells(i, "B").Value) Then            If ws.Cells(i, "B").Value <> 0 Then                ws.Cells(i, "E").Value = ws.Cells(i, "C").Value / ws.Cells(i, "B").Value            Else                ws.Cells(i, "E").Value = "目标为零"            End If        Else            ws.Cells(i, "E").Value = "数据错误"        End If    Next i    ' 将E列（完成率）格式化为百分比    ws.Range("E2:E" & lastRow).NumberFormat = "0.00%"    ' 图表需要展示：指标（A列）、实际（C列）、目标（B列）、完成率（E列）    Set rngChartData = ws.Range("A1:A" & lastRow & ",B1:C" & lastRow & ",E1:E" & lastRow)    ' 定义图表位置放置在D7单元格右侧）    sngLeft = ws.Range("D7").Left    sngTop = ws.Range("D7").Top    ' 创建图表对象    Set chartObj = ws.ChartObjects.Add(Left:=sngLeft, Top:=sngTop, Width:=400, Height:=230)    Set cht = chartObj.Chart    With cht        '设置图表基本属性        .SetSourceData Source:=rngChartData        .chartType = xlColumnClustered ' 初始簇状柱形类型        .HasTitle = True        .ChartTitle.Text = "指标完成情况分析图"        With .SeriesCollection(3)            .chartType = xlLine            .AxisGroup = xlSecondary            .MarkerStyle = xlMarkerStyleCircle            .MarkerSize = 7        End With        ' 设置坐标轴标题        .Axes(xlCategory, xlPrimary).HasTitle = True        .Axes(xlCategory, xlPrimary).AxisTitle.Text = ws.Range("A1").Value ' 指标名称        ' 设置图例位置        .HasLegend = True        .Legend.Position = xlLegendPositionBottom        '调整主坐标轴        With .Axes(xlValue, xlPrimary)            .MaximumScale = 1000            .Format.Line.Visible = msoFalse            .TickLabels.Font.ColorIndex = xlColorIndexNone        End With        '调整次坐标轴        With .Axes(xlValue, xlSecondary)            .MaximumScale = 1.5            .MinimumScale = -1            .Format.Line.Visible = msoFalse            .TickLabels.Font.ColorIndex = xlColorIndexNone        End With        ' 添加数据标签        .SeriesCollection(1).HasDataLabels = True        .SeriesCollection(2).HasDataLabels = True        .SeriesCollection(3).HasDataLabels = True        .Axes(xlValue).MajorGridlines.Delete '删除网格线    End With    Set targetSeries = cht.SeriesCollection("完成率") ' 通过名称获取系列    For i = 1 To targetSeries.Points.Count        If targetSeries.Values(i) >= 1 Then ' 判断完成率是否≥100%            With targetSeries.Points(i).Format.Fill                .ForeColor.RGB = RGB(0, 176, 80) ' 绿色                .Visible = msoTrue            End With        Else            With targetSeries.Points(i).Format.Fill                .ForeColor.RGB = RGB(255, 0, 0) ' 红色                .Visible = msoTrue            End With        End If    Next i    Application.ScreenUpdating = True    MsgBox "数据计算与图表生成完成！", vbInformation    Exit SubErrorHandler:    Application.ScreenUpdating = True    MsgBox "运行过程中出现错误：" & Err.Description, vbCriticalEnd Sub