PublicSub ChartInterior() Dim myChart As Chart 'Reference embedded chart Set myChart = ActiveSheet.ChartObjects(1).Chart With myChart 'Alter interior colors of chart components .ChartArea.Interior.Color =RGB(1, 2, 3) .PlotArea.Interior.Color =RGB(11, 12, 1) .Legend.Interior.Color =RGB(31, 32, 33) If .HasTitle Then .ChartTitle.Interior.Color =RGB(41, 42, 43) EndIf EndWith End Sub
PublicSub SetXAxis() Dim myAxis As Axis Set myAxis = ActiveSheet.ChartObjects(1).Chart.Axes(xlCategory, xlPrimary) With myAxis 'Set properties of x-axis .HasMajorGridlines =True .HasTitle =True .AxisTitle.Text ="My Axis" .AxisTitle.Font.Color =RGB(1, 2, 3) .CategoryNames = Range("C2:C11") .TickLabels.Font.Color =RGB(11, 12, 13) EndWith End Sub
PublicSub TestSeries() Dim mySeries As Series Dim seriesCol As SeriesCollection Dim I AsInteger I =1 Set seriesCol = ActiveSheet.ChartObjects(1).Chart.SeriesCollection ForEach mySeries In seriesCol Set mySeries = ActiveSheet.ChartObjects(1).Chart.SeriesCollection(I) With mySeries .MarkerBackgroundColor =RGB(1, 32, 43) .MarkerForegroundColor =RGB(11, 32, 43) .Border.Color =RGB(11, 12, 23) EndWith I = I +1 Next End Sub
PublicSub TestPoint() Dim myPoint As Point Set myPoint = ActiveSheet.ChartObjects(1).Chart.SeriesCollection(1).Points(3) With myPoint .ApplyDataLabels xlDataLabelsShowValue .MarkerBackgroundColor =RGB(1, 2, 3) .MarkerForegroundColor =RGB(11, 22, 33) EndWith End Sub
Sub chartAxis() Dim myChartObject As ChartObject Set myChartObject = ActiveSheet.ChartObjects.Add(Left:=200, Top:=200, _ Width:=400, Height:=300)
With myChartObject.Axes(Type:=xlCategory, AxisGroup:=xlPrimary) .HasTitle =True .AxisTitle.Text ="Years" .AxisTitle.Font.Name ="Times New Roman" .AxisTitle.Font.Size =12 .HasMajorGridlines =True .HasMinorGridlines =False EndWith End Sub
Sub FormattingCharts() Dim myChart As Chart Dim ws As Worksheet Dim ax As Axis
Set ws = ThisWorkbook.Worksheets("Sheet1") Set myChart = GetChartByCaption(ws, "GDP")
Set ax =Nothing Set myChart =Nothing Set ws =Nothing End Sub Function GetChartByCaption(ws As Worksheet, sCaption AsString) As Chart Dim myChart As ChartObject Dim myChart As Chart Dim sTitle AsString
Set myChart =Nothing ForEach myChart In ws.ChartObjects If myChart.Chart.HasTitle Then sTitle = myChart.Chart.ChartTitle.Caption IfStrComp(sTitle, sCaption, vbTextCompare) =0Then Set myChart = myChart.Chart ExitFor EndIf EndIf Next Set GetChartByCaption = myChart Set myChart =Nothing Set myChart =Nothing End Function
2. 使用VBA在Excel中添加图表
PublicSub AddChartSheet() Dim aChart As Chart
Set aChart = Charts.Add With aChart .Name ="Mangoes" .ChartType = xlColumnClustered .SetSourceData Source:=Sheets("Sheet1").Range("A3:D7"), PlotBy:=xlRows .HasTitle =True .ChartTitle.Text ="=Sheet1!R3C1" EndWith End Sub
3. 遍历并更改Chart对象中的图表类型
Sub ChartType() Dim myChart As ChartObject ForEach myChart In ActiveSheet.ChartObjects myChart.Chart.Type = xlArea Next myChart End Sub
4. 遍历并更改Chart对象中的Legend
Sub LegendMod() Dim myChart As ChartObject ForEach myChart In ActiveSheet.ChartObjects With myChart.Chart.Legend.font .name ="Calibri" .FontStyle ="Bold" .Size =12 EndWith Next myChart End Sub
5. 一个格式化Chart的例子
Sub ChartMods() ActiveChart.Type = xlArea ActiveChart.ChartArea.font.name ="Calibri" ActiveChart.ChartArea.font.FontStyle ="Regular" ActiveChart.ChartArea.font.Size =9 ActiveChart.PlotArea.Interior.ColorIndex = xlNone ActiveChart.Axes(xlValue).TickLabels.font.bold =True ActiveChart.Axes(xlCategory).TickLabels.font.bold =True ActiveChart.Legend.Position = xlBottom End Sub
6. 通过VBA更改Chart的Title
Sub ApplyTexture() Dim myChart As Chart Dim ser As Series Set myChart = ActiveChart Set ser = myChart.SeriesCollection(2) ser.Format.Fill.PresetTextured (msoTextureGreenMarble) End Sub
7. 在VBA中使用自定义图片填充Chart对象的series区域
Sub FormatWithPicture() Dim myChart As Chart Dim ser As Series Set myChart = ActiveChart Set ser = myChart.SeriesCollection(1) MyPic ="C:\Title.jpg" ser.Format.Fill.UserPicture (MyPic) End Sub
Sub TwoColorGradient() Dim myChart As Chart Dim ser As Series Set myChart = ActiveChart Set ser = myChart.SeriesCollection(1) MyPic ="C:\Title1.jpg" ser.Format.Fill.TwoColorGradient msoGradientFromCorner, 3 ser.Format.Fill.ForeColor.ObjectThemeColor = msoThemeColorAccent6 ser.Format.Fill.BackColor.ObjectThemeColor = msoThemeColorAccent2 End Sub
8. 通过VBA格式化Chart对象中series的趋势线样式
Sub FormatLineOrBorders() Dim myChart As Chart Set myChart = ActiveChart With myChart.SeriesCollection(1).Trendlines(1).Format.Line .DashStyle = msoLineLongDashDotDot .ForeColor.RGB =RGB(50, 0, 128) .BeginArrowheadLength = msoArrowheadShort .BeginArrowheadStyle = msoArrowheadOval .BeginArrowheadWidth = msoArrowheadNarrow .EndArrowheadLength = msoArrowheadLong .EndArrowheadStyle = msoArrowheadTriangle .EndArrowheadWidth = msoArrowheadWide EndWith End Sub
Sub FormatBorder() Dim myChart As Chart Set myChart = ActiveChart With myChart.ChartArea.Format.Line .DashStyle = msoLineLongDashDotDot .ForeColor.RGB =RGB(50, 0, 128) EndWith End Sub
Sub AddGlowToTitle() Dim myChart As Chart Set myChart = ActiveChart myChart.ChartTitle.Format.Line.ForeColor.RGB =RGB(255, 255, 255) myChart.ChartTitle.Format.Line.DashStyle = msoLineSolid myChart.ChartTitle.Format.Glow.Color.ObjectThemeColor = msoThemeColorAccent6 myChart.ChartTitle.Format.Glow.Radius =8 End Sub
Sub FormatShadow() Dim myChart As Chart Set myChart = ActiveChart With myChart.Legend.Format.Shadow .ForeColor.RGB =RGB(0, 0, 128) .OffsetX =5 .OffsetY =-3 .Transparency =0.5 .Visible =True EndWith End Sub
Sub FormatSoftEdgesWithLoop() Dim myChart As Chart Dim ser As Series Set myChart = ActiveChart Set ser = myChart.SeriesCollection(1) For i =1To6 ser.Points(i).Format.SoftEdge.Type = i Next i End Sub
10. 在VBA中对Chart对象应用3D效果
Sub Assign3DPreset() Dim myChart As Chart Dim shp As Shape Set myChart = ActiveChart Set shp = myChart.Shapes(1) shp.ThreeD.SetPresetCamera msoCameraIsometricLeftDown End Sub
Sub AssignBevel() Dim myChart As Chart Dim ser As Series Set myChart = ActiveChart Set ser = myChart.SeriesCollection(1) ser.Format.ThreeD.Visible =True ser.Format.ThreeD.BevelTopType = msoBevelCircle ser.Format.ThreeD.BevelTopInset =16 ser.Format.ThreeD.BevelTopDepth =6 End Sub
Set ax =Nothing Set myChart =Nothing Set ws =Nothing End Sub Function GetChartByCaption(ws As Worksheet, sCaption AsString) As Chart Dim myChart As ChartObject Dim myChart As Chart Dim sTitle AsString
Set myChart =Nothing ForEach myChart In ws.ChartObjects If myChart.Chart.HasTitle Then sTitle = myChart.Chart.ChartTitle.Caption IfStrComp(sTitle, sCaption, vbTextCompare) =0Then Set myChart = myChart.Chart ExitFor EndIf EndIf Next Set GetChartByCaption = myChart Set myChart =Nothing Set myChart =Nothing End Function
2. 通过VBA给Chart添加Lengend
Sub legend() Dim myChartObject As ChartObject Set myChartObject = ActiveSheet.ChartObjects.Add(Left:=200, Top:=200, _ Width:=400, Height:=300)
myChartObject.SeriesCollection.Add Source:=ActiveSheet.Range("C4:K4"), Rowcol:=xlRows myChartObject.SeriesCollection.NewSeries With myChartObject.Legend .HasLegend =True .Font.Size =16 .Font.Name ="Arial" EndWith End Sub
Sub ProtectChart() Dim myChart As Chart Set myChart = ThisWorkbook.Sheets("Protected Chart") myChart.Protect "123456", True, True, , True myChart.ProtectData =False myChart.ProtectGoalSeek =True myChart.ProtectSelection =True End Sub
Sub UnprotectChart() Dim myChart As Chart Set myChart = ThisWorkbook.Sheets("Protected Chart") myChart.Unprotect "123456" myChart.ProtectData =False myChart.ProtectGoalSeek =False myChart.ProtectSelection =False End Sub
myChartObject.SeriesCollection.Add Source:=ActiveSheet.Range("C4:K4"), Rowcol:=xlRows myChartObject.SeriesCollection.NewSeries myChartObject.HasTitle =True End Sub
如果要设置标题显示的位置,可以在上述代码的后面加上: With myChartObject.ChartTitle .Top = 100 .Left = 150 End With 如果要同时设置标题字体,可以在上述代码的后面加上: myChartObject.ChartTitle.Font.Name = "Times"
2. 通过VBA修改图表的标题
Sub charTitleText() ActiveChart.ChartTitle.Text ="Industrial Disease in North Dakota" End Sub
3. 一个通过标题搜索图表的例子
Function GetChartByCaption(ws As Worksheet, sCaption AsString) As Chart Dim myChart As ChartObject Dim myChart As Chart Dim sTitle AsString
Set myChart =Nothing ForEach myChart In ws.ChartObjects If myChart.Chart.HasTitle Then sTitle = myChart.Chart.ChartTitle.Caption IfStrComp(sTitle, sCaption, vbTextCompare) =0Then Set myChart = myChart.Chart ExitFor EndIf EndIf Next Set GetChartByCaption = myChart Set myChart =Nothing Set myChart =Nothing End Function Sub TestGetChartByCaption() Dim myChart As Chart Dim ws As Worksheet Set ws = ThisWorkbook.Worksheets("Sheet1") Set myChart = GetChartByCaption(ws, "I am the Chart Title")
Sub CreateExampleChartVersionI() Dim ws As Worksheet Dim rgChartData As Range Dim myChart As Chart
Set ws = ThisWorkbook.Worksheets("Sheet1") Set rgChartData = ws.Range("B1").CurrentRegion Set myChart = Charts.Add Set myChart = myChart.Location(xlLocationAsObject, ws.Name) With myChart .ChartWizard _ Source:=rgChartData, _ Gallery:=xlColumn, _ Format:=1, _ PlotBy:=xlColumns, _ CategoryLabels:=1, _ SeriesLabels:=1, _ HasLegend:=True, _ Title:="Version I", _ CategoryTitle:="Year", _ ValueTitle:="GDP in billions of $" EndWith
Set myChart =Nothing Set rgChartData =Nothing Set ws =Nothing End Sub
使用Chart Object方法创建
Sub CreateExampleChartVersionII() Dim ws As Worksheet Dim rgChartData As Range Dim myChart As Chart
Set ws = ThisWorkbook.Worksheets("Basic Chart") Set rgChartData = ws.Range("B1").CurrentRegion Set myChart = Charts.Add Set myChart = myChart.Location(xlLocationAsObject, ws.Name)
With .Axes(xlCategory) .HasTitle =True .AxisTitle.Caption ="Year" EndWith
With .Axes(xlValue) .HasTitle =True .AxisTitle.Caption ="GDP in billions of $" EndWith
EndWith
Set myChart =Nothing Set rgChartData =Nothing Set ws =Nothing End Sub
使用ActiveWorkbook.Sheets.Add方法创建
Sub chart() Dim myChartSheet As Chart Set myChartSheet = ActiveWorkbook.Sheets.Add _ (After:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count), _ Type:=xlChart) End Sub
使用ActiveSheet.ChartObjects.Add方法创建
Sub charObj() Dim myChartObject As ChartObject Set myChartObject = ActiveSheet.ChartObjects.Add(Left:=200, Top:=200, _ Width:=400, Height:=300) myChartObject.Chart.SetSourceData Source:= _ ActiveWorkbook.Sheets("Chart Data").Range("A1:E5") End Sub
.SeriesCollection(1).name ="Sample Data" .SeriesCollection(1).Values = dataRange EndWith End Sub
3. 通过选取的Cells Range的值设置Chart中数据标签的内容
Sub DataLabelsFromRange() Dim DLRange As range Dim myChart As Chart Dim i AsInteger
Set myChart = ActiveSheet.ChartObjects(1).Chart OnErrorResumeNext Set DLRange = Application.InputBox _ (prompt:="Range for data labels?", Type:=8) If DLRange IsNothingThenExitSub OnErrorGoTo0 myChart.SeriesCollection(1).ApplyDataLabels Type:=xlDataLabelsShowValue, AutoText:=True, LegendKey:=False Pts = myChart.SeriesCollection(1).Points.Count For i =1To Pts myChart.SeriesCollection(1). _ Points(i).DataLabel.Characters.Text = DLRange(i) Next i End Sub
考虑下面这个场景,当采用下表的数据生成图表Chart4时,默认的效果如下图。
可以手动给该图表添加Data Labels,方法是选中任意的series,右键选择Add Data Labels。如果想要为所有的series添加Data Labels,则需要依次选择不同的series,然后重复该操作。 Excel中可以通过VBA将指定Cells Range中的值设置到Chart的Data Labels中,上面的代码就是一个例子。程序执行的时候会首先弹出一个提示框,要求用户通过鼠标去选择一个单元格区域以获取到Cells集合(或者直接输入地址),如下图:
Sub AddDataLabels() Dim seSales As Series Dim pts As Points Dim pt As Point Dim rngLabels As range Dim iPointIndex AsInteger
Set rngLabels = range("B4:G4")
Set seSales = ActiveSheet.ChartObjects(1).Chart.SeriesCollection(1) seSales.HasDataLabels =True
Set pts = seSales.Points
ForEach pt In pts iPointIndex = iPointIndex +1 pt.DataLabel.text = rngLabels.cells(iPointIndex).text pt.DataLabel.font.bold =True pt.DataLabel.Position = xlLabelPositionAbove Next pt End Sub