1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93
| Option Explicit
Sub CreateChart(Atitle As String, Asheet As String, Arange As Range)
'---------------------------------------------------------------------------------------
' Procedure : CreateChart
' Author : neo2k2
' Date : 09/06/2008
' Purpose :
'---------------------------------------------------------------------------------------
'
On Error GoTo CreateChart_Error
'
Dim achart As String, acell As String, xcell As String
Dim i As Long, n As Long, num As Long
Dim k As String
Charts.Add
'
With ActiveChart
.Name = Atitle
.ChartType = xlLineMarkers
.SetSourceData Source:=Arange, PlotBy:= _
xlColumns
.Location Where:=xlLocationAsObject, Name:=Asheet
End With
'
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection.NewSeries
'
acell = Range("C12").Address
xcell = Range("C12").Offset(0, -1).Address
If Len(acell) > 4 Then
num = Right(Range(acell).Offset(1, 0).Address, 2)
Else
num = Right(Range(acell).Offset(1, 0).Address, 1)
End If
'
n = 1
k = Range("C65536").End(xlUp).Address
If Len(k) > 4 Then
k = Right(k, 2)
Else
k = Right(k, 1)
End If
For i = 13 To k
If Range("C" & i).Value = Range("C" & i + 1).Value Then
n = n + 1
Else
n = n
Exit For
End If
Next i
'
acell = Range(xcell).Offset(1, 2).Address
'
ActiveChart.SeriesCollection(1).XValues = Range(Range(xcell).Offset(1, 0).Address & ":" & Range(xcell).Offset(n, 0).Address).Value
ActiveChart.SeriesCollection(1).Values = Sheets(Asheet).Range("D" & num & ":D" & num + n - 1)
ActiveChart.SeriesCollection(1).Name = Range("C" & num).Value
ActiveChart.SeriesCollection(2).Values = Sheets(Asheet).Range("D" & num + n & ":D" & num + 2 * n - 1)
ActiveChart.SeriesCollection(2).Name = Range("C" & num + n).Value
ActiveChart.SeriesCollection(3).Values = Sheets(Asheet).Range("D" & num + 2 * n & ":D" & num + 3 * n - 1)
ActiveChart.SeriesCollection(3).Name = Range("C" & num + 2 * n).Value
'
With ActiveChart
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = Range(xcell).Value
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = Range(Range(xcell).Offset(0, 2).Address).Value
End With
With ActiveChart.PageSetup
.ChartSize = xlFitToPage
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Zoom = 100
End With
achart = Right(ActiveChart.Name, Len(ActiveChart.Name) - (Len(Asheet) + 1))
With ActiveSheet.Shapes(achart)
.Top = 400
.Left = 2
.ScaleWidth 0.77, msoFalse, msoScaleFromTopLeft
.ScaleHeight 0.77, msoFalse, msoScaleFromTopLeft
End With
Range("A1").Select
'
On Error GoTo 0
Exit Sub
CreateChart_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure CreateChart of Module Module6"
'
End Sub |
Partager