用于处理图表&图形的VBA代码大全7：一个综合示例

Sub CreateBulletChart()
  Dim cht As Chart
  Dim srs As Series
  Dim rng As Range
  '创建空图表
  Set cht = Sheets("Sheet2").Shapes.AddChart2.Chart
  '修改图表标题文本
  cht.ChartTitle.Text = "使用VBA创建的子弹图"
  '隐藏图例
  cht.HasLegend = False
  '修改图表类型
  cht.ChartType = xlBarClustered
  '选择图表数据源
  Set rng = Sheets("Sheet2").Range("A1:D4")
  cht.SetSourceData Source:=rng
  '反转分类轴的顺序
  cht.Axes(xlCategory).ReversePlotOrder = True
  '修改条形的重叠设置
  cht.ChartGroups(1).Overlap = 100
  '修改条形间的间隙距离
  cht.ChartGroups(1).GapWidth = 50
  '修改填充颜色
  Set srs = cht.SeriesCollection(1)
  srs.Format.Fill.ForeColor.RGB = RGB(200, 200, 200)
  Set srs = cht.SeriesCollection(2)
  srs.Format.Fill.ForeColor.RGB = RGB(150, 150, 150)
  Set srs = cht.SeriesCollection(3)
  srs.Format.Fill.ForeColor.RGB = RGB(100, 100, 100)
  '添加新的图表系列
  Set srs = cht.SeriesCollection.NewSeries
  srs.Values = "=Sheet2!$B$7:$D$7"
  srs.XValues = "=Sheet2!$B$5:$D$5"
  srs.Name = "=""实际"""
  '修改图表类型
  srs.ChartType = xlXYScatter
  '打开/关闭误差线
  srs.HasErrorBars = True
  '修改误差线端部样式
  srs.ErrorBars.EndStyle = xlNoCap
  '设置误差线
  srs.ErrorBar Direction:=xlY, _
    Include:=xlNone, _
    Type:=xlErrorBarTypeCustom
  srs.ErrorBar Direction:=xlX, _
    Include:=xlMinusValues, _
    Type:=xlPercent, _
    Amount:=100
  '修改误差线颜色
  srs.ErrorBars.Format.Line.ForeColor.RGB = RGB(0, 0, 0)
  '修改误差线宽度
  srs.ErrorBars.Format.Line.Weight = 14
  '修改标记类型
  srs.MarkerStyle = xlMarkerStyleNone
  '添加新的图表系列
  Set srs = cht.SeriesCollection.NewSeries
  srs.Values = "=Sheet2!$B$7:$D$7"
  srs.XValues = "=Sheet2!$B$6:$D$6"
  srs.Name = "=""目标"""
  '修改图表类型
  srs.ChartType = xlXYScatter
  '打开/关闭误差线
  srs.HasErrorBars = True
  '修改误差线端部样式
  srs.ErrorBars.EndStyle = xlNoCap
  srs.ErrorBar Direction:=xlX, _
    Include:=xlNone, _
    Type:=xlErrorBarTypeCustom
  srs.ErrorBar Direction:=xlY, _
    Include:=xlBoth, _
    Type:=xlFixedValue, _
    Amount:=0.45
  '修改误差线颜色
  srs.ErrorBars.Format.Line.ForeColor.RGB = RGB(255, 0, 0)
  '修改误差线宽度
  srs.ErrorBars.Format.Line.Weight = 2
  '修改标记类型
  srs.MarkerStyle = xlMarkerStyleNone
  '设置图表坐标轴最小值和最大值
  cht.Axes(xlValue, xlSecondary).MaximumScale = cht.SeriesCollection(1).Points.Count
  cht.Axes(xlValue, xlSecondary).MinimumScale = 0
  '隐藏坐标轴
  cht.HasAxis(xlValue, xlSecondary) = False

End Sub