yurble_vn
08-12-2007, 07:02 AM
HI all,
I'm doing on creating an timeline chart, then any input will be draw automatically...
But I'm facing to follow and need you all help:
1.First it works when there is only one series, but after add another series, it crash. And the error is :"Runtime error:1004 Unable to Set the XValues Properties of The Series Class"
2.And I also need you all help in change control component properties. Here I'm trying to change the scroll bar max- min value in VBA. But realy dont know how the code look like. (I'm newbie in VBA :help)
3. Is there anyway to catch event from control component change in real time. I mean when I drag the scroll bar, the chart based on it will change continuously and in real time.
Here is the code and the file, please help :(:
Option Explicit
Private Sub DrawButton_Click()
Dim FirstDay As Double
Dim LastDay As Double
Dim DateValue As Double
Dim MaxEvent As Integer
Dim LastRow As Integer
Dim icount As Integer
Dim linecount1 As Integer
Dim linecount2 As Integer
Dim height As Integer
'On Error Resume Next
Const DataLabelLine As Integer = 25
'Clear Content
Range("AA26:AK60000").ClearContents
'Count Events
MaxEvent = Application.CountA(Range("B:B")) - Application.CountA(Range("B1:B25"))
'Last Row
LastRow = MaxEvent + DataLabelLine
' Get display range
FirstDay = Range("AB25")
LastDay = Range("AC25")
'Initailize line count
linecount1 = 0
linecount2 = 0
'Filter Data in chosen range
For icount = DataLabelLine + 1 To LastRow
DateValue = Cells(icount, 5).Value
If (DateValue > FirstDay) And (DateValue < LastDay) Then
linecount1 = linecount1 + 1
Cells(linecount1 + DataLabelLine, 28) = Cells(icount, 5)
Cells(linecount1 + DataLabelLine, 29) = Cells(icount, 6)
End If
Next
For icount = DataLabelLine + 1 To LastRow
DateValue = Cells(icount, 7).Value
If (DateValue > FirstDay) And (DateValue < LastDay) Then
linecount2 = linecount2 + 1
Cells(linecount2 + DataLabelLine, 36) = Cells(icount, 7)
Cells(linecount2 + DataLabelLine, 37) = Cells(icount, 8)
End If
Next
'Formart range back to number
Columns("AA:AC").Select
With Selection
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Columns("AI:AL").Select
With Selection
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
'Filter data for calculation
Range("AA26:AC" & linecount1 + DataLabelLine).Sort Key1:=Range("AB26"), Order1:=xlAscending, Header:=xlGuess _
, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("AI26:AK" & linecount2 + DataLabelLine).Sort Key1:=Range("AJ26"), Order1:=xlAscending, Header:=xlGuess _
, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
'Count height for Series 1
height = 50
For icount = 1 To linecount1
If height > 4 Then
Cells(icount + DataLabelLine, 27) = height
height = height - 5
Else
height = 50
Cells(icount + DataLabelLine, 27) = height
height = height - 5
End If
Next
'Count height for Series 2
height = 50
For icount = 1 To linecount2
If height > 4 Then
Cells(icount + DataLabelLine, 35) = -height
height = height - 5
Else
height = 50
Cells(icount + DataLabelLine, 35) = -height
height = height - 5
End If
Next
'Drawing Chart
ActiveSheet.ChartObjects("Chart 1").Activate
If Range("AD25").Value = "True" Then
ActiveChart.SeriesCollection(1).XValues = "=EventList!R26C28:R" & (linecount1 + DataLabelLine) & "C28"
ActiveChart.SeriesCollection(1).Values = "=EventList!R26C27:R" & (linecount1 + DataLabelLine) & "C27"
Else
ActiveChart.SeriesCollection(1).XValues = "=EventList!R1C28:R6C28"
ActiveChart.SeriesCollection(1).Values = "=EventList!R1C27:R6C27"
End If
If Range("AL25").Value = "True" Then
ActiveChart.SeriesCollection(2).XValues = "=EventList!R26C36:R" & (linecount2 + DataLabelLine) & "C36"
ActiveChart.SeriesCollection(2).Values = "=EventList!R26C35:R" & (linecount2 + DataLabelLine) & "C35"
Else
ActiveChart.SeriesCollection(2).XValues = "=EventList!R1C36:R6C36"
ActiveChart.SeriesCollection(2).Values = "=EventList!R1C35:R6C35"
End If
'Set Chart range
With ActiveChart.Axes(xlCategory)
.MinimumScale = FirstDay - 10
.MaximumScale = LastDay + 10
.MinorUnit = 30
.MajorUnit = 30
.Crosses = xlAutomatic
.ReversePlotOrder = False
.ScaleType = xlLinear
.DisplayUnit = xlNone
End With
End Sub
I'm doing on creating an timeline chart, then any input will be draw automatically...
But I'm facing to follow and need you all help:
1.First it works when there is only one series, but after add another series, it crash. And the error is :"Runtime error:1004 Unable to Set the XValues Properties of The Series Class"
2.And I also need you all help in change control component properties. Here I'm trying to change the scroll bar max- min value in VBA. But realy dont know how the code look like. (I'm newbie in VBA :help)
3. Is there anyway to catch event from control component change in real time. I mean when I drag the scroll bar, the chart based on it will change continuously and in real time.
Here is the code and the file, please help :(:
Option Explicit
Private Sub DrawButton_Click()
Dim FirstDay As Double
Dim LastDay As Double
Dim DateValue As Double
Dim MaxEvent As Integer
Dim LastRow As Integer
Dim icount As Integer
Dim linecount1 As Integer
Dim linecount2 As Integer
Dim height As Integer
'On Error Resume Next
Const DataLabelLine As Integer = 25
'Clear Content
Range("AA26:AK60000").ClearContents
'Count Events
MaxEvent = Application.CountA(Range("B:B")) - Application.CountA(Range("B1:B25"))
'Last Row
LastRow = MaxEvent + DataLabelLine
' Get display range
FirstDay = Range("AB25")
LastDay = Range("AC25")
'Initailize line count
linecount1 = 0
linecount2 = 0
'Filter Data in chosen range
For icount = DataLabelLine + 1 To LastRow
DateValue = Cells(icount, 5).Value
If (DateValue > FirstDay) And (DateValue < LastDay) Then
linecount1 = linecount1 + 1
Cells(linecount1 + DataLabelLine, 28) = Cells(icount, 5)
Cells(linecount1 + DataLabelLine, 29) = Cells(icount, 6)
End If
Next
For icount = DataLabelLine + 1 To LastRow
DateValue = Cells(icount, 7).Value
If (DateValue > FirstDay) And (DateValue < LastDay) Then
linecount2 = linecount2 + 1
Cells(linecount2 + DataLabelLine, 36) = Cells(icount, 7)
Cells(linecount2 + DataLabelLine, 37) = Cells(icount, 8)
End If
Next
'Formart range back to number
Columns("AA:AC").Select
With Selection
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Columns("AI:AL").Select
With Selection
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
'Filter data for calculation
Range("AA26:AC" & linecount1 + DataLabelLine).Sort Key1:=Range("AB26"), Order1:=xlAscending, Header:=xlGuess _
, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("AI26:AK" & linecount2 + DataLabelLine).Sort Key1:=Range("AJ26"), Order1:=xlAscending, Header:=xlGuess _
, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
'Count height for Series 1
height = 50
For icount = 1 To linecount1
If height > 4 Then
Cells(icount + DataLabelLine, 27) = height
height = height - 5
Else
height = 50
Cells(icount + DataLabelLine, 27) = height
height = height - 5
End If
Next
'Count height for Series 2
height = 50
For icount = 1 To linecount2
If height > 4 Then
Cells(icount + DataLabelLine, 35) = -height
height = height - 5
Else
height = 50
Cells(icount + DataLabelLine, 35) = -height
height = height - 5
End If
Next
'Drawing Chart
ActiveSheet.ChartObjects("Chart 1").Activate
If Range("AD25").Value = "True" Then
ActiveChart.SeriesCollection(1).XValues = "=EventList!R26C28:R" & (linecount1 + DataLabelLine) & "C28"
ActiveChart.SeriesCollection(1).Values = "=EventList!R26C27:R" & (linecount1 + DataLabelLine) & "C27"
Else
ActiveChart.SeriesCollection(1).XValues = "=EventList!R1C28:R6C28"
ActiveChart.SeriesCollection(1).Values = "=EventList!R1C27:R6C27"
End If
If Range("AL25").Value = "True" Then
ActiveChart.SeriesCollection(2).XValues = "=EventList!R26C36:R" & (linecount2 + DataLabelLine) & "C36"
ActiveChart.SeriesCollection(2).Values = "=EventList!R26C35:R" & (linecount2 + DataLabelLine) & "C35"
Else
ActiveChart.SeriesCollection(2).XValues = "=EventList!R1C36:R6C36"
ActiveChart.SeriesCollection(2).Values = "=EventList!R1C35:R6C35"
End If
'Set Chart range
With ActiveChart.Axes(xlCategory)
.MinimumScale = FirstDay - 10
.MaximumScale = LastDay + 10
.MinorUnit = 30
.MajorUnit = 30
.Crosses = xlAutomatic
.ReversePlotOrder = False
.ScaleType = xlLinear
.DisplayUnit = xlNone
End With
End Sub