VBA/Excel/Access/Word/Excel/Chart
Содержание
- 1 Activates the ChartObject named Chart 1
- 2 Add Chart
- 3 Adding a Chart Sheet Using VBA Code
- 4 Adding a New Series to the chart identified by the object variable myChart, drawing the data from the range C4:K4 on the active worksheet in the active workbook, using rows:
- 5 add the data labels using the following code:
- 6 Automatically generating a chart without user interaction
- 7 convert an existing chart to use arrays instead of cell references and make it independent of the original data
- 8 Creating a Chart
- 9 Creating a Chart on an Existing Worksheet
- 10 Creating a Chart Using the Chart Object
- 11 Creating an Embedded Chart
- 12 Creating a New Chart Using the ChartWizard Method
- 13 Creating a New Series, use the NewSeries method with the SeriesCollection collection.
- 14 Creating Charts
- 15 Determining a chart"s source data
- 16 Extending an Existing Series in the chart identified by the object variable myChart using the data in the cells P3:P8 on the worksheet named Chart Data:
- 17 Get Chart SeriesCollection value
- 18 Get Chart sheet
- 19 Get Embedded Charts
- 20 In most cases you can avoid using the worksheet Index property
- 21 Insert chart sheets after each worksheet
- 22 Inserts a chart before each sheet
- 23 Inserts a chart before each sheet 2
- 24 Insert two chart sheets after the last worksheet in the active workbook. The chart sheets receive default names, such as Chart1 and Chart2:
- 25 Modifying the chart type
- 26 Producing an Excel worksheet on a Word ocument
- 27 Reference Char object from ActiveSheet
- 28 Referencing Charts and Chart Objects in VBA Code
- 29 Retrieving data point labels from field names in the worksheet
- 30 Select a chart object
- 31 Show chart
- 32 Specify Exact Location
- 33 Specifying the Chart Type
- 34 Specifying the Source Data for the Chart by using the SetSourceData method of the Chart object
- 35 To ensure that a chart is selected, you can add a statement to determine if a chart is active.
- 36 Use For Each to loop through all chart objects
Activates the ChartObject named Chart 1
<source lang="vb">
Sub activate()
ActiveSheet.ChartObjects("Chart 1").Activate
End Sub
</source>
Add Chart
<source lang="vb">
Sub AddChart()
Dim aChart As Chart ActiveSheet.ChartObjects.Delete Set aChart = Charts.Add Set aChart = aChart.Location(Where:=xlLocationAsObject, Name:="Sheet1") With aChart .ChartType = xlColumnClustered .SetSourceData Source:=Sheets("Sheet1").Range("A3:D7"), _ PlotBy:=xlRows .HasTitle = True .ChartTitle.Text = "=Sheet1!R3C1" With .Parent .Top = Range("F3").Top .Left = Range("F3").Left .Name = "MangoesChart" End With End With
End Sub
</source>
Adding a Chart Sheet Using VBA Code
<source lang="vb"> Sub AddChartSheet() Dim myChart As Chart Set myChart = Charts.add With myChart .SetSourceData Source:=Sheets("Sheet1").range("A3:D7"), _ PlotBy:=xlRows .ChartType = xlColumnClustered .HasTitle = True .ChartTitle.text = "Mangoes" End With End Sub </source>
Adding a New Series to the chart identified by the object variable myChart, drawing the data from the range C4:K4 on the active worksheet in the active workbook, using rows:
<source lang="vb">
Sub series()
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
End Sub
</source>
add the data labels using the following code:
<source lang="vb"> 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 </source>
Automatically generating a chart without user interaction
<source lang="vb">
Sub CreateChart(r)
Dim TempChart As Chart Application.ScreenUpdating = False Set CatTitles = ActiveSheet.range("A2:F2") Set SrcRange = ActiveSheet.range(Cells(r, 1), Cells(r, 6)) Set SourceData = Union(CatTitles, SrcRange) Set TempChart = Charts.Add With TempChart .ChartType = xlColumnClustered .SetSourceData Source:=SourceData, PlotBy:=xlRows .HasLegend = False .ApplyDataLabels Type:=xlDataLabelsShowValue, _ LegendKey:=False .ChartTitle.Font.Size = 14 .ChartTitle.Font.Bold = True .Axes(xlValue).MaximumScale = 0.6 .Axes(xlCategory).TickLabels.Font.Size = 10 .Axes(xlCategory).TickLabels.Orientation = _ xlHorizontal .Location Where:=xlLocationAsObject, name:="Sheet1" End With With ActiveSheet.ChartObjects(1) .Width = 300 .Height = 150 .Visible = False End With
End Sub
</source>
convert an existing chart to use arrays instead of cell references and make it independent of the original data
<source lang="vb"> Sub ConvertSeriesValuesToArrays() Dim seSeries As Series Dim myChart As Chart On Error GoTo Failure Set myChart = ActiveSheet.ChartObjects(1).Chart For Each seSeries In myChart.SeriesCollection seSeries.Values = seSeries.Values seSeries.XValues = seSeries.XValues seSeries.name = seSeries.name Next seSeries Exit Sub
Failure:
MsgBox "Sorry, the data exceeds the array limits""" End Sub </source>
Creating a Chart
<source lang="vb">
Sub chart()
Dim myChartSheet As Chart Set myChartSheet = ActiveWorkbook.Sheets.Add _ (After:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count), _ Type:=xlChart)
End Sub
</source>
Creating a Chart on an Existing Worksheet
<source lang="vb">
Sub charObj()
Dim myChartObject As ChartObject Set myChartObject = ActiveSheet.ChartObjects.Add(Left:=200, Top:=200, _ Width:=400, Height:=300)
End Sub
</source>
Creating a Chart Using the Chart Object
<source lang="vb">
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
</source>
Creating an Embedded Chart
<source lang="vb">
Public Sub AddEmbeddedChart()
Dim dataRange As Range Set dataRange = ActiveWindow.Selection "Chart selected data ActiveSheet.ChartObjects.Add Left:=200, Top:=50, Width:=500,Height:=350 ActiveSheet.ChartObjects(1).Activate With ActiveChart "Set chart properties .ChartType = xlColumnClustered .SeriesCollection.NewSeries .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, xlPrimary).HasTitle = True .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text ="X-axis Labels" .Axes(xlValue, xlPrimary).HasTitle = True .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Y-axis" .SeriesCollection(1).name = "Sample Data" .SeriesCollection(1).Values = dataRange End With
End Sub
</source>
Creating a New Chart Using the ChartWizard Method
<source lang="vb">
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
</source>
Creating a New Series, use the NewSeries method with the SeriesCollection collection.
<source lang="vb">
Sub newSeries()
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
End Sub
</source>
Creating Charts
<source lang="vb">
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
</source>
Determining a chart"s source data
<source lang="vb">
Sub Test1()
Dim DataRange As range Set DataRange = ActiveSheet.range("A1:A2") ActiveSheet.ChartObjects(1).Chart.SeriesCollection(1).Values = DataRange
End Sub
</source>
Extending an Existing Series in the chart identified by the object variable myChart using the data in the cells P3:P8 on the worksheet named Chart Data:
<source lang="vb">
Sub chartSource()
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.Extend Source:=Worksheets("Chart Data").Range("P3:P8")
End Sub
</source>
Get Chart SeriesCollection value
<source lang="vb">
Sub Test2()
Dim DataRange As range Set DataRange = Sheets("Sheet1").ChartObjects(1).Chart.SeriesCollection(1).Values
End Sub
</source>
Get Chart sheet
<source lang="vb">
Public Sub GetChartSheets()
Dim myCharts As Sheets Dim chSheet As Chart Set myCharts = ActiveWorkbook.Charts For Each chSheet In myCharts Debug.Print chSheet.name Next
End Sub
</source>
Get Embedded Charts
<source lang="vb">
Public Sub GetEmbeddedCharts()
Dim myChart As ChartObject Dim myCharts As ChartObjects Set myCharts = ActiveSheet.ChartObjects For Each myChart In myCharts Debug.Print myChart.Chart.name Next
End Sub
</source>
In most cases you can avoid using the worksheet Index property
<source lang="vb"> Sub InsertChartsBeforeWorksheets2() Dim myWorksheet As Worksheet For Each myWorksheet In Worksheets Charts.add Before:=myWorksheet Next myWorksheet End Sub </source>
Insert chart sheets after each worksheet
<source lang="vb"> Sub InsertChartsAfterWorksheets() Dim myWorksheet As Worksheet Dim myChart As Chart For Each myWorksheet In Worksheets Set myChart = Charts.add myChart.Move After:=myWorksheet Next myWorksheet End Sub </source>
Inserts a chart before each sheet
<source lang="vb">
Sub InsertChartsBeforeWorksheets()
Dim myWorksheet As Worksheet For Each myWorksheet In Worksheets Charts.Add Before:=Sheets(myWorksheet.Index) Next myWorksheet
End Sub
</source>
Inserts a chart before each sheet 2
<source lang="vb">
Sub InsertChartsBeforeWorksheets2()
Dim myWorksheet As Worksheet For Each myWorksheet In Worksheets Charts.Add Before:=myWorksheet Next myWorksheet
End Sub
</source>
Insert two chart sheets after the last worksheet in the active workbook. The chart sheets receive default names, such as Chart1 and Chart2:
<source lang="vb">
Sub addAfter()
ActiveWorkbook.Sheets.Add After:=Sheets(Sheets.Count), Count:=2, Type:=xlChart
End Sub
</source>
Modifying the chart type
<source lang="vb">
Sub ModifyChart1()
ActiveSheet.ChartObjects("Chart 1").activate ActiveChart.Type = xlArea
End Sub
</source>
Producing an Excel worksheet on a Word ocument
<source lang="vb">
Sub MakeExcelChart()
Dim XLSheet As Object Documents.Add Wbook = "\projections.xls" Set XLSheet = GetObject(Wbook, "Excel.Sheet").ActiveSheet XLSheet.range("Value") = 1 XLSheet.range("Change") = 2 XLSheet.Calculate Selection.Font.Size = 14 Selection.Font.Bold = True Selection.TypeText "Monthly Increment: " & Format(2, "0.0%") Selection.TypeParagraph Selection.TypeParagraph XLSheet.range("data").Copy Selection.Paste XLSheet.ChartObjects(1).Copy Selection.PasteSpecial _ Link:=False, _ DataType:=wdPasteMetafilePicture, _ Placement:=wdInLine, DisplayAsIcon:=False Set XLSheet = Nothing
End Sub
</source>
Reference Char object from ActiveSheet
<source lang="vb">
Sub m()
ActiveSheet.ChartObjects(1).Select
End Sub
</source>
Referencing Charts and Chart Objects in VBA Code
<source lang="vb">
Sub SpecifyLocation()
Dim WS As Worksheet Set WS = Worksheets("Sheet1") WS.Shapes.AddChart(xlColumnClustered, Left:=100, Top:=150, Width:=400, Height:=300).Select ActiveChart.SetSourceData Source:=WS.range("A1:E4")
End Sub
</source>
Retrieving data point labels from field names in the worksheet
<source lang="vb">
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
</source>
Select a chart object
<source lang="vb">
Sub m()
ActiveWorkbook.Charts(1).Select
End Sub
</source>
Show chart
<source lang="vb">
Sub ShowChart()
UserRow = ActiveCell.Row If UserRow < 2 Or IsEmpty(Cells(UserRow, 1)) Then MsgBox "Move the cell cursor to a row that contains data." Exit Sub End If CreateChart (UserRow)
End Sub
</source>
Specify Exact Location
<source lang="vb">
Sub SpecifyExactLocation()
Dim WS As Worksheet Set WS = Worksheets("Sheet1") WS.Shapes.AddChart(xlColumnClustered, _ Left:=WS.range("C11").Left, _ Top:=WS.range("C11").Top, _ Width:=WS.range("C11:J11").Width, _ Height:=WS.range("C11:C30").Height).Select ActiveChart.SetSourceData Source:=WS.range("A1:E4")
End Sub
</source>
Specifying the Chart Type
<source lang="vb">
Sub chartType()
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.ChartType = xlColumnStacked
End Sub
</source>
Specifying the Source Data for the Chart by using the SetSourceData method of the Chart object
<source lang="vb">
Sub width()
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
</source>
To ensure that a chart is selected, you can add a statement to determine if a chart is active.
<source lang="vb">
Sub ChartMods2()
If ActiveChart Is Nothing Then MsgBox "Activate a chart." Exit Sub End If 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
</source>
Use For Each to loop through all chart objects
<source lang="vb">
Sub ChangeCharts()
Dim myChart As ChartObject For Each myChart In Sheets("Sheet1").ChartObjects myChart.Chart.ChartType = xlLine Next myChart
End Sub
</source>