VBA/Excel/Access/Word/Excel/Chart

Материал из VB Эксперт
Перейти к: навигация, поиск

Содержание

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>