VBA专题09：基本的Excel图表编程代码

Sub CreateChart()
    Dim rng As Range
    Dim cht As Object
   
   '用于绘制图表的数据区域
    Set rng =ActiveSheet.Range("A1:B10")
   
   '创建图表
    Set cht = ActiveSheet.Shapes.AddChart2
   
   '添加图表数据
    cht.Chart.SetSourceData Source:=rng
   
   '确定图表类型
    cht.Chart.ChartType = xlXYScatterLines
End Sub

Sub CreateChart()
    Dim rng As Range
    Dim cht As ChartObject
   
   '用于绘制图表的数据区域
    Set rng =ActiveSheet.Range("A1:B10")
   
   '创建图表
    Setcht = ActiveSheet.ChartObjects.Add( _
        Left:=ActiveCell.Left, _
        Width:=500, _
        Top:=ActiveCell.Top, _
        Height:=300)
       
   '添加图表数据
    cht.Chart.SetSourceData Source:=rng
   
   '确定图表类型
    cht.Chart.ChartType = xlXYScatterLines
End Sub

Sub LoopCharts()
    Dim cht As ChartObject
    Dim srs As Series
   
   '遍历当前工作表中所有图表
    For Each cht In ActiveSheet.ChartObjects
   
    Next cht
   
   '遍历某图表中所有系列
    For Each srs In cht.Chart.SeriesCollection
   
    Next srs
   
   '遍历当前工作表中所有图表的系列
    For Each cht In ActiveSheet.ChartObjects
        For Each srs Incht.Chart.SeriesCollection
       
        Next srs
    Next cht
End Sub

Sub AddChartTitle()
    Dim cht As ChartObject
   
    Set cht = ActiveSheet.ChartObjects("图表 1")
   
   '确保图表有标题
    cht.Chart.HasTitle = True
   
   '修改图表标题
    cht.Chart.ChartTitle.Text = "示例图表"
End Sub

Sub RepositionChartTitle()
   '重定位标题
    Dim cht As ChartObject
   
    Set cht = ActiveSheet.ChartObjects("图表 1")
   
    With cht.Chart.ChartTitle
        .Left = 150
        .Top = 60
    End With
End Sub

Sub AddLegend()
    Dim cht As Chart
   
    Set cht = ActiveSheet.ChartObjects("图表1").Chart
   
   '在右侧添加图例
    cht.SetElement (msoElementLegendRight)
   
   '在左侧添加图例
    cht.SetElement (msoElementLegendLeft)
   
   '在底部添加图例
    cht.SetElement (msoElementLegendBottom)
   
   '在顶部添加图例
    cht.SetElement (msoElementLegendTop)
   
   '在左侧添加与图表重叠的图例
    cht.SetElement(msoElementLegendLeftOverlay)
   
   '在右侧添加与图表重叠的图例
    cht.SetElement(msoElementLegendRightOverlay)
End Sub

Sub PlaceLegend()
   '在指定位置放置图例
    Dim lgd As Legend
   
    Set lgd = ActiveSheet.ChartObjects("图表1").Chart.Legend
   
    With lgd
        .Left = 250
        .Top = 7
        .Width = 100
        .Height = 25
    End With
End Sub

Sub AddAttributes()
    Dim cht As Chart
   
    Set cht = ActiveSheet.ChartObjects("图表1").Chart
   
   '添加x轴
    cht.HasAxis(xlCategory, xlPrimary) = True '方法1
    cht.SetElement(msoElementPrimaryCategoryAxisShow) '方法2
   
   '添加x轴标题
    cht.Axes(xlCategory, xlPrimary).HasTitle =True '方法1
    cht.SetElement(msoElementPrimaryCategoryAxisTitleAdjacentToAxis) '方法2
       
   '添加y轴
    cht.HasAxis(xlValue, xlPrimary) = True '方法1
    cht.SetElement(msoElementPrimaryValueAxisShow) '方法2
   
   '添加y轴标题
    cht.Axes(xlValue, xlPrimary).HasTitle =True '方法1
    cht.SetElement(msoElementPrimaryValueAxisTitleAdjacentToAxis) '方法2
   
   '添加数据标签(居中)
    cht.SetElement (msoElementDataLabelCenter)
   
   '添加主要网格线
    cht.SetElement (msoElementPrimaryValueGridLinesMajor)
   
   '添加线性趋势线
    cht.SeriesCollection(1).Trendlines.AddType:=xlLinear
End Sub

Sub ModifyAttributes()
    Dim cht As Chart
   
    Set cht = ActiveSheet.ChartObjects("图表1").Chart
   
   '调整y轴比例
    cht.Axes(xlValue).MinimumScale = 500
    cht.Axes(xlValue).MaximumScale = 4800
   
   '调整x轴比例
    cht.Axes(xlCategory).MinimumScale = 1
    cht.Axes(xlCategory).MaximumScale = 10
   
   '调整柱条间隙
    cht.ChartGroups(1).GapWidth = 50
   
   '格式化字体大小
   cht.ChartArea.Format.TextFrame2.TextRange.Font.Size = 11
   
   '格式化字体类型
   cht.ChartArea.Format.TextFrame2.TextRange.Font.Name = "微软雅黑"
   
   '加粗字体
   cht.ChartArea.Format.TextFrame2.TextRange.Font.Bold = msoTrue
   
   '设置斜体
    cht.ChartArea.Format.TextFrame2.TextRange.Font.Italic= msoTrue
End Sub

Sub RemoveAttributes()
    Dim cht As Chart
   
    Set cht = ActiveSheet.ChartObjects("图表1").Chart
   
   '移除图表系列
    cht.SeriesCollection(1).Delete
   
   '移除网格线
    cht.Axes(xlValue).MajorGridlines.Delete
    cht.Axes(xlValue).MinorGridlines.Delete
   
   '移除x轴
    cht.Axes(xlCategory).Delete
   
   '移除y轴
    cht.Axes(xlValue).Delete
   
   '移除图例
    cht.Legend.Delete
   
   '移除标题
    cht.ChartTitle.Delete
   
   '移除图表区边框
    cht.ChartArea.Border.LineStyle = xlNone
   
   '无背景色填充
    cht.ChartArea.Format.Fill.Visible =msoFalse
    cht.PlotArea.Format.Fill.Visible = msoFalse
End Sub

Sub ChangeColors()
    Dim cht As Chart
   
    Set cht = ActiveSheet.ChartObjects("图表2").Chart
   
   '修改第一个条形系列的填充颜色
   cht.SeriesCollection(1).Format.Fill.ForeColor.RGB = RGB(90, 150, 210)
   
   '修改x轴标签颜色
    cht.Axes(xlCategory).TickLabels.Font.Color= RGB(90, 150, 210)
   
   '修改y轴标签颜色
    cht.Axes(xlValue).TickLabels.Font.Color =RGB(90, 150, 210)
   
   '修改绘图区边框颜色
    cht.PlotArea.Format.Line.ForeColor.RGB =RGB(90, 150, 210)
   
   '修改主网格线颜色
    cht.Axes(xlValue).MajorGridlines.Format.Line.ForeColor.RGB= RGB(90, 150, 210)
   
   '修改图表标题字体颜色
   cht.ChartTitle.Format.TextFrame2.TextRange.Font.Fill.ForeColor.RGB =RGB(90, 150, 210)
   
   '无背景颜色填充
    cht.ChartArea.Format.Fill.Visible = msoFalse
    cht.PlotArea.Format.Fill.Visible = msoFalse
End Sub