Excel VBA 自動生成圖表（chart)

Sub ChartAdd()

    Dim myRange As Range

    Dim myChart As ChartObject

    Dim R As Integer

 

    If Sheet1.ChartObjects.Count > 0 Then

        Sheet1.ChartObjects.Delete 'delete charts

    End If

    R = Sheet1.Range("A65536").End(xlUp).Row   'get rows

     

    If Sheet1.Cells(2, 2) <> "" Then

        With Sheet1

            Set myRange = .Range("B" & 2 & ":D" & R) 'get data

            

            Set myChart = .ChartObjects.Add(20, 120, 400, 250) ' create chart(left,top,width,height)

    

            With myChart.Chart

   

               .ChartType = xlLineMarkers ' xlColumnClustered  chart type

     

               .SetSourceData Source:=myRange, PlotBy:=xlRows ' chart data source

   

                .ApplyDataLabels ShowValue:=True ' show data

    

                .Axes(xlCategory, xlPrimary).HasTitle = True

   

                .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "quantity" 'X Axis

   

                .Axes(xlValue, xlPrimary).HasTitle = True

   

                .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Month of year"       'Y Axis

   

                .ChartGroups(1).VaryByCategories = True

    

                .Axes(xlValue, xlPrimary).MaximumScale = Application.WorksheetFunction.Ceiling(Application.WorksheetFunction.Max(myRange), 50) + 50  ' Y Axis max value

                .Axes(xlValue, xlPrimary).MajorUnit = 50

                .Axes(xlValue, xlPrimary).MinorUnit = 50 ' scale

               .Axes(xlCategory, xlPrimary).CategoryNames = Sheet1.Range("B1:D1")

   

                .HasTitle = True

   

               .ChartTitle.Text = "Asus Quantity Static"

     

                With .ChartTitle.Font

    

                    .Size = 20

    

                    .ColorIndex = 3

    

                   .Name = "arial"

    

                End With

    

               With .ChartArea.Interior

    

                  .ColorIndex = 8 'background

   

                   .PatternColorIndex = 2 '

   

                   .Pattern = xlSolid

   

                End With

   

               With .PlotArea.Interior

                    .ColorIndex = 35 'data background

    

                   .PatternColorIndex = 2

    

                   .Pattern = xlSolid

    

                End With

   

                .HasLegend = True

   

                .SeriesCollection(2).Points(1).MarkerBackgroundColor = RGB(255, 0, 0)

   

                .SeriesCollection(1).Name = Sheet1.Cells(2, 1)

   

                .SeriesCollection(2).Name = Sheet1.Cells(3, 1)

                .SeriesCollection(3).Name = Sheet1.Cells(4, 1)

   

                .SeriesCollection(4).Name = Sheet1.Cells(5, 1)

               

                 If .SeriesCollection(1).Points(1).DataLabel.Text = "34" Then

    

                    .SeriesCollection(1).Border.ColorIndex = 3 'change line color

                   .SeriesCollection(1).Border.Weight = xlThick

    

                 End If

   

                '.SeriesCollection(1).DataLabels.Delete  'delete number

    

               With .SeriesCollection(2).DataLabels.Font

   

                    .Size = 10

   

                    .ColorIndex = 1 '

                End With

     With .ChartArea.Fill

            .Visible = True

           .ForeColor.SchemeColor = 0

          .BackColor.SchemeColor = 3

          .TwoColorGradient Style:=msoGradientHorizontal, Variant:=1

      End With

      .HasDataTable = True

            End With

    

        End With

   

    End If

minValue = Application.WorksheetFunction.Min(Worksheets("Sheet1").Range("B2:D5"))

Worksheets("sheet1").ChartObjects(1).RoundedCorners = True

    Set myRange = Nothing

 

    Set myChart = Nothing

 

End Sub

'--------單元格chang事件

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim chgRow As Integer

    Dim chgCol As Integer

   

    chgRow = Target.Cells.Row

    chgCol = Target.Cells.Column

   

    If chgRow > 1 And chgRow < 6 And chgCol > 1 And chgCol < 5 Then

       Call ChartAdd

    End If

End Sub