VBA的使用（2）

1. 图表操作

Sub InsertGraph()
Dim myChtObj As ChartObject
Dim rngChtData As Range
Dim rngChtXVal As Range
Dim iColumn As Long
Dim mySrs As Series
 
 ' make sure a range is selected
 If TypeName(Selection) <> "Range" Then Exit Sub
 
 ' define chart data
 Set rngChtData = Sheets("Graph").Range("d5:bc25")
 
 ' define chart's X values
 With rngChtData
   Set rngChtXVal = .Columns(1).Offset(1).Resize(.Rows.Count - 1)
 End With
 
  ' add the chart
  Set myChtObj = ActiveSheet.ChartObjects.Add _
  (Left:=250, Width:=800, Top:=75, Height:=350)
  With myChtObj.Chart
    .Legend.Delete                                           'delete legend
    .Axes(xlValue).MinimumScale = 0                          'set min time value
    .Axes(xlValue).MaximumScale = 1                          'set max time value
    .Axes(xlValue).MajorUnit = 0.0416666666                  'set time increments to 1 hr
    .Axes(xlValue).TickLabels.Orientation = 55               'set time label angle
    .Axes(xlCategory).CategoryType = xlCategoryScale         'set date labels to text
    .Axes(xlCategory).ReversePlotOrder = True                'set order to reverse order
    .ChartType = xlBarStacked                                ' make an XY chart
    .HasTitle = True                                         'add chart title
    .ChartTitle.Characters.Text = Sheets(1).Range("a1") & Chr(10) & "DUTY TIME RECORD FOR WEEK ENDING" _
      & " " & Format(Sheets(20).Range("D24"), "mm/dd/yyyy") & Chr(10) & Chr(10) & Sheets(20).Range("b3") _
      & Chr(10) & "EMP ID - " & Sheets(20).Range("b2")       'set chart title
    .ChartGroups(1).GapWidth = 0
    Do Until .SeriesCollection.Count = 0                     ' remove extra series
      .SeriesCollection(1).Delete
    Loop
 
    ' add series from selected range, column by column
    For iColumn = 2 To rngChtData.Columns.Count
      With .SeriesCollection.NewSeries
        .Values = rngChtXVal.Offset(, iColumn - 1)
        .XValues = "=GRAPH!$D$6:$D$25"                       'set verticle labels
      End With
    Next
 
  'set all bar colors to blue
  For i = 1 To .SeriesCollection.Count
    With .SeriesCollection(i)
      .Interior.Color = RGB(114, 137, 234)
    End With
     i = i + 1
    Next

  'set flight time bar colors to yellow
  For m = 1 To .SeriesCollection.Count
    For x = 2 To .SeriesCollection(m).Points.Count
      With .SeriesCollection(m).Points(x)
        .Interior.Color = RGB(248, 240, 86)
      End With
      x = x + 2
   Next
  Next

    'set even numbered series to transparent
  For n = 2 To .SeriesCollection.Count
    With .SeriesCollection(n)
      .Interior.ColorIndex = xlNone
    End With
   n = n + 1
  Next
 End With
End Sub