如何在VBA中设置xlColumnClustered为单色且数据标签显示在柱形下方？

Problem #

When creating a clustered column chart (xlColumnClustered) via VBA, I notice there are two default styles: one with multi-colored bars, and another monochrome variant that shows data labels below each bar. Right now my code generates the multi-colored version by default, but I need to set it to the second style. How can I achieve this in VBA?

Here's my current code:

Sub CreateGraph()
 Dim strChrt As String
 Dim ws As Worksheet
 Dim x As Integer
 Dim lastRow As Integer
 Dim lastCol As Integer
 Dim myShape As Shape
 Set ws = ActiveSheet
 lastCol = ws.Cells(3, Columns.Count).End(xlToLeft).Column
 lastRow = ws.Cells(Rows.Count, "B").End(xlUp).Row
 For x = 4 To lastRow
 With ws
 Set range1 = .Range(.Cells(3, "A"), .Cells(3, lastCol))
 Set range2 = .Range(.Cells(x, "A"), .Cells(x, lastCol))
 Set range3 = Union(range1, range2)
 Set myShape = .Shapes.AddChart2(201, xlColumnClustered)
 End With
 With myShape.Chart
 .SetSourceData Source:=range3
 .ChartTitle.Text = ws.Cells(x, "A")
 .ChartType = xlColumnClustered
 .HasLegend = False
 End With
 With myShape.Chart.Axes(xlValue)
 .HasTitle = True
 .AxisTitle.Caption = "Frequency"
 End With
 With myShape.Chart.Axes(xlCategory)
 .HasTitle = True
 .AxisTitle.Caption = "Time"
 End With
 Next x
End Sub

Solution #

To get the exact style you want, we'll adjust two key parts of your code:

1. Use the Monochrome Chart Style Preset #

Your current code uses AddChart2(201, xlColumnClustered) where 201 is the ID for the multi-colored clustered column style. The monochrome variant you're targeting has a style ID of 207. You can either pass this ID directly when creating the chart, or set it after creation with the ChartStyle property.

Option 1 (Set during chart creation):

Set myShape = .Shapes.AddChart2(207, xlColumnClustered)

Option 2 (Set after chart creation):

With myShape.Chart
    ' ... your existing chart config code ...
    .ChartStyle = 207
End With

2. Enable and Position Data Labels #

While the 207 style might include data labels by default, it's safe to explicitly set their position to ensure they consistently show up below the bars. Add this loop after configuring the chart:

Dim srs As Series
For Each srs In myShape.Chart.SeriesCollection
    srs.HasDataLabels = True
    srs.DataLabels.Position = xlLabelPositionBelow
Next srs

Full Modified Code #

Here's your updated code with both changes included:

Sub CreateGraph()
 Dim strChrt As String
 Dim ws As Worksheet
 Dim x As Integer
 Dim lastRow As Integer
 Dim lastCol As Integer
 Dim myShape As Shape
 Dim srs As Series ' Variable for looping through chart series
 Set ws = ActiveSheet
 lastCol = ws.Cells(3, Columns.Count).End(xlToLeft).Column
 lastRow = ws.Cells(Rows.Count, "B").End(xlUp).Row
 For x = 4 To lastRow
 With ws
 Set range1 = .Range(.Cells(3, "A"), .Cells(3, lastCol))
 Set range2 = .Range(.Cells(x, "A"), .Cells(x, lastCol))
 Set range3 = Union(range1, range2)
 ' Create chart with monochrome style directly
 Set myShape = .Shapes.AddChart2(207, xlColumnClustered)
 End With
 With myShape.Chart
 .SetSourceData Source:=range3
 .ChartTitle.Text = ws.Cells(x, "A")
 .ChartType = xlColumnClustered
 .HasLegend = False
 End With
 ' Ensure data labels are enabled and positioned below bars
 For Each srs In myShape.Chart.SeriesCollection
     srs.HasDataLabels = True
     srs.DataLabels.Position = xlLabelPositionBelow
 Next srs
 With myShape.Chart.Axes(xlValue)
 .HasTitle = True
 .AxisTitle.Caption = "Frequency"
 End With
 With myShape.Chart.Axes(xlCategory)
 .HasTitle = True
 .AxisTitle.Caption = "Time"
 End With
 Next x
End Sub

Quick Notes #

• If 207 doesn't match the style you want (style IDs can vary slightly by Excel version), you can find the correct ID manually: set up the chart style you want in Excel, then open the VBA Immediate Window (Ctrl+G), type ?ActiveChart.ChartStyle, and press Enter to get the ID.
• You can adjust data label positions using other constants like xlLabelPositionAbove, xlLabelPositionInsideEnd, or xlLabelPositionOutsideEnd if needed.

内容的提问来源于stack exchange，提问作者Ludo