|
-
June 16th, 2009, 01:40 AM
#5
Re: ChartSpace: Error 438 when double clicking the same portion
I get the code from this blog: http://blogs.msdn.com/access/archive...de-sample.aspx
Below is the code in which I read and get the code from:
Option Explicit
Private Const HandCursor = 32649&
Private Declare Function SetCursor Lib "user32" (ByVal hCursor As Long) As Long
Private Declare Function LoadCursor Lib "user32" Alias "LoadCursorA" (ByVal hInstance As Long, ByVal lpCursorName As Long) As Long
Dim WithEvents oChart As ChartSpace
Private Sub Form_Load()
Set oChart = Me.ChartSpace
End Sub
Private Sub Form_Click()
Dim sVal As String
Dim sYear As String
Dim iSeperator As Integer
Select Case Me.ChartSpace.SelectionType
Case chSelectionPoint
sVal = Me.ChartSpace.Selection.GetValue(chDimCategories)
iSeperator = InStr(1, sVal, "-") 'make sure we only filter for year or month and year
If iSeperator = 0 Then 'selection is a year
FilterByYear sVal
ElseIf InStr(iSeperator + 1, sVal, "-") = 0 Then
'selection is a month and year
sYear = Trim$(Mid$(sVal, 1, iSeperator - 1))
sVal = Trim$(Mid$(sVal, iSeperator + 1))
FilterByMonth sYear, sVal
Else
Exit Sub 'selection is a day or somthing of a lower level that we don't filter for
End If
Case chSelectionCategoryLabel
'set the source object to the proper form
sVal = Me.ChartSpace.Selection.Caption
Select Case Me.ChartSpace.Selection.Level 'check to see what level was selected on the x axis
Case 0 'year
FilterByYear sVal
Case 1 'month
sYear = Me.ChartSpace.Selection.ParentLabel.Caption
FilterByMonth sYear, sVal
Case Else
Exit Sub 'selection is a day or somthing of a lower level that we don't filter for
End Select
End Select
End Sub
'filters the db list by month
Private Sub FilterByMonth(sYear As String, sVal As String)
Me.Parent.Form.Filter = BuildSQL(Trim$(sYear), Trim$(sVal))
Me.Parent.Form.FilterOn = True
End Sub
'filters the db list by year
Private Sub FilterByYear(sVal As String)
Me.Parent.Form.Filter = BuildSQL(Trim$(sVal), "")
If Me.Parent.Form.FilterOn = False Then Me.Parent.Form.FilterOn = True
End Sub
' builds the SQL that will filter the form
Private Function BuildSQL(sYear As String, sMonth As String) As String
Dim sFilterField As String
Dim sFilterControl As String
sFilterField = "[Est Closed Date]"
sFilterControl = "Est Closed Date"
If sMonth <> "" Then 'passed in year and month
BuildSQL = "(" & sFilterField & " >= #" & FormatDateTime(sMonth & " - " & sYear) & "#) AND (" & sFilterField & " <= #" & DateAdd("m", 1, FormatDateTime(sMonth & " - " & sYear)) - 1 & "#)"
Else 'just passed in the year
BuildSQL = "(" & sFilterField & " >= #1/1/" & sYear & "#) AND (" & sFilterField & " <= #12/31/" & sYear & "#)"
End If
'Clear the filter from the field the chart is filtered on.
'If you want to clear the entire filter, just set Me.Parent.Filter = "".
RemoveFilterFromField Me.Parent, sFilterControl
' If there is still something left of the filter
If Me.Parent.Filter <> "" Then
' Append
BuildSQL = BuildSQL & " AND (" & Me.Parent.Filter & ")"
End If
End Function
Private Sub RemoveFilterFromField(frm As Form, strControlName As String)
frm.SetFocus
frm.Controls(strControlName).SetFocus
On Error Resume Next
DoCmd.RunCommand acCmdRemoveFilterFromCurrentColumn ' This command is new to Access 2007.
Debug.Assert Err.Number = 0 Or Err.Number = 2046 ' 2046 is thrown when there was no filter on the column
Err.Clear
End Sub
Private Sub Form_CommandBeforeExecute(ByVal Command As Variant, ByVal Cancel As Object)
' Cancel the ability to drill into days and hours.
If Command = chCommandDrill Then
Cancel = True
End If
End Sub
Private Sub oChart_MouseMove(ByVal Button As Long, ByVal Shift As Long, ByVal x As Long, ByVal y As Long)
Select Case TypeName(Me.ChartSpace.RangeFromPoint(x, y))
Case "ChCategoryLabel", "ChPoint"
'display hand cursor if pointer is over a label or bar
SetCursor LoadCursor(0, HandCursor)
Case Else
'display the normal cursor
Screen.MousePointer = 0
End Select
End Sub
Btw, how to put the code tag?
Thank you for your help.
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|