в 16:33, 26 мая 2010

2010-05-26T16:33:00Z

Admin: 1 версия

2010-05-26T12:47:35Z

1 версия

Новая страница

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

← Предыдущая	Версия 16:33, 26 мая 2010
(нет различий)

VBA/Excel/Access/Word/Excel/Chart - История изменений

в 16:33, 26 мая 2010

Admin: 1 версия