|
这样修改后
Option Explicit
Sub AddChart()
Dim ws As Worksheet, NewSer As Series
Dim ch As ChartObject, chRng As Range, wdZoom As Variant
Application.ScreenUpdating = False
On Error GoTo Errhandler
Set ws = Worksheets("OQC入檢年度推移圖")
Set chRng = ws.Range("A2:O8")
ws.Activate
wdZoom = ActiveWindow.Zoom
ActiveWindow.Zoom = 75
For Each ch In ws.ChartObjects
If Not (Intersect(ws.Range("A1:O8"), ch.TopLeftCell) Is Nothing) Then ch.Delete
Next ch
Set ch = ws.ChartObjects.Add(chRng.Left + 2, chRng.Top + 2, chRng.Width, chRng.Height)
ch.Name = "OQC入檢年度推移圖"
With ch.Chart
.ChartType = xlLineMarkers
Set NewSer = .SeriesCollection.NewSeries
With NewSer
.XValues = ws.Range("C10:C21")
.Values = ws.Range("F10:F21")
.Name = ws.Range("F9")
With .Border
.ColorIndex = 5
.Weight = xlMedium
.LineStyle = xlContinuous
End With
.MarkerStyle = xlCircle
.MarkerSize = 7
.MarkerBackgroundColorIndex = 7
.MarkerForegroundColorIndex = 7 '此句要在End With之前
End With
Set NewSer = .SeriesCollection.NewSeries
With NewSer
.XValues = ws.Range("C10:C21") '修改
.Values = ws.Range("G10:G21") '修改
.Name = ws.Range("G9") '修改
With .Border
.ColorIndex = 11
.Weight = xlThin
.LineStyle = xlContinuous
End With
.MarkerStyle = xlDiamond
.MarkerSize = 7
.MarkerBackgroundColorIndex = 11
.MarkerForegroundColorIndex = 11
End With
Set NewSer = .SeriesCollection.NewSeries
With NewSer
.XValues = ws.Range("C10:C21")
.Values = ws.Range("J10:J21") '修改
.Name = ws.Range("J9") '修改
.AxisGroup = xlSecondary
With .Border
.ColorIndex = 3
.Weight = xlMedium
.LineStyle = xlContinuous
End With
.MarkerStyle = xlStar
.MarkerSize = 7
.MarkerBackgroundColorIndex = xlNone
.MarkerForegroundColorIndex = 10
End With
Set NewSer = .SeriesCollection.NewSeries
With NewSer
.XValues = ws.Range("C10:C21")
.Values = ws.Range("K10:K21") '修改
.Name = ws.Range("K9") '修改
.AxisGroup = xlSecondary
With .Border
.ColorIndex = 5
.Weight = xlThin
.LineStyle = xlContinuous
End With
.MarkerStyle = xlX
.MarkerSize = 7
.MarkerBackgroundColorIndex = xlNone
.MarkerForegroundColorIndex = 5
End With
.HasTitle = True
With .ChartTitle
.AutoScaleFont = False
.Caption = "OQC入檢年度品質推移圖(TOTAL)"
.Font.Name = "新細明體"
.Font.FontStyle = "Bold"
.Font.Size = 18
.Left = 140
.Top = 0
End With
With .Axes(xlValue, xlPrimary)
.HasMajorGridlines = False
.HasTitle = True
With .AxisTitle
.AutoScaleFont = False
.Caption = ws.Range("F9") & "(%)"
.Font.Name = "新細明體"
.Font.Size = 10
End With
.TickLabels.AutoScaleFont = False
With .TickLabels.Font
.Name = "Arial"
.Size = 10
End With
End With
With .Axes(xlValue, xlSecondary)
.HasTitle = True
With .AxisTitle
.AutoScaleFont = False
.Caption = ws.Range("J9") & "(ppm)"
.Font.Name = "新細明體"
.Font.Size = 10
End With
.TickLabels.AutoScaleFont = False
With .TickLabels.Font
.Name = "Arial"
.Size = 10
End With
End With
With .Axes(xlCategory).TickLabels
.AutoScaleFont = False
With .Font
.Name = "Arial"
.Size = 10
End With
End With
With .Legend
.AutoScaleFont = False
With .Font
.Name = "新細明體"
.Size = 10
End With
.Position = xlTop
.Left = 400
.Top = 8
End With
With .PlotArea
.Interior.ColorIndex = 34
.Left = 15
.Top = 20
.Width = 610
.Height = 135
End With
End With
Errhandler:
Set ws = Nothing
Set NewSer = Nothing
Set ch = Nothing
Set chRng = Nothing
ActiveWindow.Zoom = wdZoom
Application.ScreenUpdating = True
End Sub
还有一个问题是你工作表中9月起无数据的单元格中都有一个0长度字符，这样图表中就不会忽略，会以数值0来处理，你应该先选择空单元格区域后删除。
[此贴子已经被作者于2004-12-17 0:13:05编辑过] | 
楼主: yanchangsh
沪公网安备 31011702000001号 沪ICP备11019229号-2
楼主
发表于 2004-12-14 22:30
