目录
Chart Export
Chart Format
Chart Lengend
Chart Protect
Chart Title
Chart
Chart Export
- 1. 将Excel中的图表导出成gif格式的图片保存到硬盘上
Sub ExportChart()理论上图表可以被保存成任何类型的图片文件，读者可以自己去尝试。
Dim myChart As Chart
Set myChart = ActiveChart
myChart.Export Filename: = " C:\Chart.gif " , Filtername: = " GIF "
End Sub - 2. 将Excel中的图表导出成可交互的页面保存到硬盘上
Sub SaveChartWeb()
ActiveWorkbook.PublishObjects.Add _
SourceType: = xlSourceChart, _
Filename: = ActiveWorkbook.Path & " \Sample2.htm " , _
Sheet: = ActiveSheet.name, _
Source: = " Chart 1 " , _
HtmlType: = xlHtmlChart
ActiveWorkbook.PublishObjects( 1 ).Publish ( True )
End Sub
返回目录Chart Format
- 1. 操作Chart对象。给几个用VBA操作Excel Chart对象的例子，读者可以自己去尝试一下。
Public Sub 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 )
End If
End With
End Sub
Public Sub 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 )
End With
End Sub
Public Sub TestSeries()
Dim mySeries As Series
Dim seriesCol As SeriesCollection
Dim I As Integer
I = 1
Set seriesCol = ActiveSheet.ChartObjects( 1 ).Chart.SeriesCollection
For Each 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 )
End With
I = I + 1
Next
End Sub
Public Sub 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 )
End With
End Sub
Sub chartAxis()
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 " )
myChartObject.SeriesCollection.Add Source: = ActiveSheet.Range( " C4:K4 " ), Rowcol: = xlRows
myChartObject.SeriesCollection.NewSeries
myChartObject.HasTitle = True
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
End With
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 " )
If Not myChart Is Nothing Then
Set ax = myChart.Axes(xlCategory)
With ax
.AxisTitle.Font.Size = 12
.AxisTitle.Font.Color = vbRed
End With
Set ax = myChart.Axes(xlValue)
With ax
.HasMinorGridlines = True
.MinorGridlines.Border.LineStyle = xlDashDot
End With
With myChart.PlotArea
.Border.LineStyle = xlDash
.Border.Color = vbRed
.Interior.Color = vbWhite
.Width = myChart.PlotArea.Width + 10
.Height = myChart.PlotArea.Height + 10
End With
myChart.ChartArea.Interior.Color = vbWhite
myChart.Legend.Position = xlLegendPositionBottom
End If
Set ax = Nothing
Set myChart = Nothing
Set ws = Nothing
End Sub
Function GetChartByCaption(ws As Worksheet, sCaption As String ) As Chart
Dim myChart As ChartObject
Dim myChart As Chart
Dim sTitle As String
Set myChart = Nothing
For Each myChart In ws.ChartObjects
If myChart.Chart.HasTitle Then
sTitle = myChart.Chart.ChartTitle.Caption
If StrComp (sTitle, sCaption, vbTextCompare) = 0 Then
Set myChart = myChart.Chart
Exit For
End If
End If
Next
Set GetChartByCaption = myChart
Set myChart = Nothing
Set myChart = Nothing
End Function
- 2. 使用VBA在Excel中添加图表
Public Sub 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 "
End With
End Sub
- 3. 遍历并更改Chart对象中的图表类型
Sub ChartType()
Dim myChart As ChartObject
For Each myChart In ActiveSheet.ChartObjects
myChart.Chart.Type = xlArea
Next myChart
End Sub
- 4. 遍历并更改Chart对象中的Legend
Sub LegendMod()
Dim myChart As ChartObject
For Each myChart In ActiveSheet.ChartObjects
With myChart.Chart.Legend.font
.name = " Calibri "
.FontStyle = " Bold "
.Size = 12
End With
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区域
Excel中的Chart允许用户对其中选定的区域自定义样式，其中包括使用图片选中样式。在Excel的Layout菜单下有一个Format Selection，首先在Chart对象中选定要格式化的区域，例如series，然后选择该菜单，在弹出的对话框中即可对所选的区域进行格式化。如series选项、填充样式、边框颜色和样式、阴影以及3D效果等。下面再给出一个在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的趋势线样式
Excel允许用户为Chart对象的series添加趋势线（trendline），首先在Chart中选中要设置的series，然后选择Layout菜单下的trendline，选择一种trendline样式。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
End With
End Sub
- 9. 一组利用VBA格式化Chart对象的例子
Sub FormatBorder()
Dim myChart As Chart
Set myChart = ActiveChart
With myChart.ChartArea.Format.Line
.DashStyle = msoLineLongDashDotDot
.ForeColor.RGB = RGB ( 50 , 0 , 128 )
End With
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
End With
End Sub
Sub FormatSoftEdgesWithLoop()
Dim myChart As Chart
Dim ser As Series
Set myChart = ActiveChart
Set ser = myChart.SeriesCollection( 1 )
For i = 1 To 6
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
Chart Lengend
- 1. 设置Lengend的位置和ChartArea的颜色
Sub FormattingCharts()
Dim myChart As Chart
Dim ws As Worksheet
Dim ax As Axis
Set ws = ThisWorkbook.Worksheets( " Sheet1 " )
Set myChart = GetChartByCaption(ws, " GDP " )
If Not myChart Is Nothing Then
myChart.ChartArea.Interior.Color = vbWhite
myChart.Legend.Position = xlLegendPositionBottom
End If
Set ax = Nothing
Set myChart = Nothing
Set ws = Nothing
End Sub
Function GetChartByCaption(ws As Worksheet, sCaption As String ) As Chart
Dim myChart As ChartObject
Dim myChart As Chart
Dim sTitle As String
Set myChart = Nothing
For Each myChart In ws.ChartObjects
If myChart.Chart.HasTitle Then
sTitle = myChart.Chart.ChartTitle.Caption
If StrComp (sTitle, sCaption, vbTextCompare) = 0 Then
Set myChart = myChart.Chart
Exit For
End If
End If
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.Chart.SetSourceData Source: = _
ActiveWorkbook.Sheets( " Chart Data " ).Range( " A1:E5 " )
myChartObject.SeriesCollection.Add Source: = ActiveSheet.Range( " C4:K4 " ), Rowcol: = xlRows
myChartObject.SeriesCollection.NewSeries
With myChartObject.Legend
.HasLegend = True
.Font.Size = 16
.Font.Name = " Arial "
End With
End Sub
Chart Protect
- 1. 保护图表
Excel中的Chart可以和Sheet一样被保护，读者可以选中图表所在的Tab，然后通过Review菜单下的Protect Sheet菜单来对图表进行保护设置。代码中的Protected Chart123456是设置保护时的密码，有关Protect函数的参数和设置保护时的其它属性读者可以查阅Excel自带的帮助文档。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
- 2. 取消图表保护
与保护图表的示例相对应，可以通过VBA撤销对图表的保护设置。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
Chart Title
- 1. 通过VBA添加图表的标题
如果要设置标题显示的位置，可以在上述代码的后面加上：Sub chartTitle()
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 " )
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 As String ) As Chart
Dim myChart As ChartObject
Dim myChart As Chart
Dim sTitle As String
Set myChart = Nothing
For Each myChart In ws.ChartObjects
If myChart.Chart.HasTitle Then
sTitle = myChart.Chart.ChartTitle.Caption
If StrComp (sTitle, sCaption, vbTextCompare) = 0 Then
Set myChart = myChart.Chart
Exit For
End If
End If
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 " )
If Not myChart Is Nothing Then
Debug.Print " Found chart "
Else
Debug.Print " Sorry - chart not found "
End If
Set ws = Nothing
Set myChart = Nothing
End Sub
Chart
- 1. 通过VBA创建Chart的几种方式
使用ChartWizard方法创建使用Chart Object方法创建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 $ "
End With
Set myChart = Nothing
Set rgChartData = Nothing
Set ws = Nothing
End Sub
使用ActiveWorkbook.Sheets.Add方法创建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 myChart
.SetSourceData rgChartData, xlColumns
.HasTitle = True
.ChartTitle.Caption = " Version II "
.ChartType = xlColumnClustered
With .Axes(xlCategory)
.HasTitle = True
.AxisTitle.Caption = " Year "
End With
With .Axes(xlValue)
.HasTitle = True
.AxisTitle.Caption = " GDP in billions of $ "
End With
End With
Set myChart = Nothing
Set rgChartData = Nothing
Set ws = Nothing
End Sub
使用ActiveSheet.ChartObjects.Add方法创建Sub chart()
Dim myChartSheet As Chart
Set myChartSheet = ActiveWorkbook.Sheets.Add _
(After: = ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count), _
Type: = xlChart)
End Sub
不同的创建方法可以应用在不同的场合，如Sheet中内嵌的图表，一个独立的Chart Tab等，读者可以自己研究。最后一种方法的末尾给新创建的图表设定了数据源，这样图表就可以显示出具体的图形了。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
如果需要指定图表的类型，可以加上这句代码：
myChartObject.ChartType = xlColumnStacked
如果需要在现有图表的基础上添加新的series，下面这行代码可以参考：
myChartObject.SeriesCollection.Add Source:=ActiveSheet.Range("C4:K4"), Rowcol:=xlRows
或者通过下面这行代码对已有的series进行扩展：
myChartObject.SeriesCollection.Extend Source:=Worksheets("Chart Data").Range("P3:P8") - 2. 一个相对完整的通过VBA创建Chart的例子
' Common Excel Chart Types
' -------------------------------------------------------------------
' Chart | VBA Constant (ChartType property of Chart object) |
' ==================================================================
' Column | xlColumnClustered, xlColumnStacked, xlColumnStacked100|
' Bar | xlBarClustered, xlBarStacked, xlBarStacked100 |
' Line | xlLine, xlLineMarkersStacked, xlLineStacked |
' Pie | xlPie, xlPieOfPie |
' Scatter | xlXYScatter, xlXYScatterLines |
' -------------------------------------------------------------------
Public Sub AddChartSheet()
Dim dataRange As Range
Set dataRange = ActiveWindow.Selection
Charts.Add ' Create a chart sheet
With ActiveChart ' Set chart properties
.ChartType = xlColumnClustered
.HasLegend = True
.Legend.Position = xlRight
.Axes(xlCategory).MinorTickMark = xlOutside
.Axes(xlValue).MinorTickMark = xlOutside
.Axes(xlValue).MaximumScale = _
Application.WorksheetFunction.RoundUp( _
Application.WorksheetFunction.Max(dataRange), - 1 )
.Axes(xlCategory).HasTitle = True
.Axes(xlCategory).AxisTitle.Characters.Text = " X-axis Labels "
.Axes(xlValue).HasTitle = True
.Axes(xlValue).AxisTitle.Characters.Text = " Y-axis "
.SeriesCollection( 1 ).name = " Sample Data "
.SeriesCollection( 1 ).Values = dataRange
End With
End Sub
- 3. 通过选取的Cells Range的值设置Chart中数据标签的内容
考虑下面这个场景，当采用下表的数据生成图表Chart4时，默认的效果如下图。Sub DataLabelsFromRange()
Dim DLRange As range
Dim myChart As Chart
Dim i As Integer
Set myChart = ActiveSheet.ChartObjects( 1 ).Chart
On Error Resume Next
Set DLRange = Application.InputBox _
(prompt: = " Range for data labels? " , Type: = 8 )
If DLRange Is Nothing Then Exit Sub
On Error GoTo 0
myChart.SeriesCollection( 1 ).ApplyDataLabels Type: = xlDataLabelsShowValue, AutoText: = True , LegendKey: = False
Pts = myChart.SeriesCollection( 1 ).Points.Count
For i = 1 To Pts
myChart.SeriesCollection( 1 ). _
Points(i).DataLabel.Characters.Text = DLRange(i)
Next i
End Sub
可以手动给该图表添加Data Labels，方法是选中任意的series，右键选择Add Data Labels。如果想要为所有的series添加Data Labels，则需要依次选择不同的series，然后重复该操作。
Excel中可以通过VBA将指定Cells Range中的值设置到Chart的Data Labels中，上面的代码就是一个例子。程序执行的时候会首先弹出一个提示框，要求用户通过鼠标去选择一个单元格区域以获取到Cells集合（或者直接输入地址），如下图：
注意VBA中输入型对话框Application.InputBox的使用。在循环中将Range中的值添加到Chart的Data Labels中。 - 4. 一个使用VBA给Chart添加Data Labels的例子
Sub AddDataLabels()
Dim seSales As Series
Dim pts As Points
Dim pt As Point
Dim rngLabels As range
Dim iPointIndex As Integer
Set rngLabels = range( " B4:G4 " )
Set seSales = ActiveSheet.ChartObjects( 1 ).Chart.SeriesCollection( 1 )
seSales.HasDataLabels = True
Set pts = seSales.Points
For Each 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
本文转自Jaxu博客园博客，原文链接：http://www.cnblogs.com/jaxu/archive/2009/06/17/1505153.html，如需转载请自行联系原作者
