ppt vba编程代码大全_VBA专题09：基本的Excel图表编程代码

学习Excel技术，关注微信公众号：

excelperfect

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

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

代码1：创建图表

方法1

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 = xlXYScatterLinesEnd Sub

方法2

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 = xlXYScatterLinesEnd Sub

代码2：遍历图表/系列

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 chtEnd Sub

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

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 WithEnd Sub

代码4：添加/修改图例

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 WithEnd Sub

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

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:=xlLinearEnd Sub

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

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= msoTrueEnd Sub

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

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 = msoFalseEnd Sub

代码8：修改颜色

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 = msoFalseEnd Sub