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

图表是数据可视化的一种常用呈现方式，VBA代码可以帮助我们自动化创建图表及对图表进行相关的操作，特别是当工作表中有大量图表需要进行重复修改时，VBA十分有用。

下面是一些基本的Excel图表编程代码，供参考！

代码1：创建图表

方法1

代码语言：javascript复制

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

方法2

代码语言：javascript复制

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

代码2：遍历图表/系列

代码语言：javascript复制

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

代码3：添加/修改图表标题

代码语言：javascript复制

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

代码语言：javascript复制

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

代码4：添加/修改图例

代码语言：javascript复制

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

代码语言：javascript复制

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

代码5：添加各种图表属性

代码语言：javascript复制

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

代码6：修改各种图表属性

代码语言：javascript复制

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

代码7：移除各种图表属性

代码语言：javascript复制

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

代码8：修改颜色

代码语言：javascript复制

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

vba

0 人点赞