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

您所在的位置:网站首页 vba自动绘图怎么实现 VBA专题09:基本的Excel图表编程代码

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

2024-07-10 18:40| 来源: 网络整理| 查看: 265

图表是数据可视化的一种常用呈现方式,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


【本文地址】


今日新闻


推荐新闻


CopyRight 2018-2019 办公设备维修网 版权所有 豫ICP备15022753号-3