P
Phil Stanton
6 - Godward (TT Reflex) Tender. Xpos: 21 YPos: 18 LableTop: 157
LabelLeft: 74
5 - Stokoe. Xpos: 31 YPos: 18
LableTop: 256 LabelLeft: 147
4 - Neale (Wizard) 12' launch. Xpos: 38 YPos: 18 LableTop: 256
LabelLeft: 151
3 - Hale. Xpos: 48 YPos: 18
LableTop: 256 LabelLeft: 229
2 - Chalmers. Xpos: 55 YPos: 18 LableTop:
256 LabelLeft: 253
1 - Jenkins (Preciouss) Jewel. Xpos: 65 YPos: 18 LableTop: 256
LabelLeft: 273
I am trying to program a chart object within Access ( & struggling)
I am using the following code, sorry it's a bit long, but there is a chunk
that is not run (Goto A)
I get a scatter chart with a level of red crosses from this data and a row
of labels very nearly level (1 degree off just to check some code) Why is
there the great anomaly (and error) for the first LabelTop result of 157
while the rest are 256.
Function LabelIt(ChtCtl As Control, Ctl As Control) As Boolean
Dim Cht As Graph.Chart
Dim ChtSeries As Series
Dim ChtLabel As DataLabel
Dim ChtArea As ChartArea
Dim DataSht As DataSheet
Dim pntDataPoint As Point
Dim MyDb As Database
Dim SpaceAllocationSet As Recordset
Dim SQLStg As String, Stg As String
Dim OrderPos As Long
Dim lCount As Long
Dim NoPoints As Long
Dim ChartHeight As Long, ChartWidth As Long
Dim LabelHeight As Long, LabelWidth As Long
Dim LabelTop As Long, LabelLeft As Long, LabelBottom As Long
Dim PointXValue As Long, PointYValue As Long
Dim LblAngle As Integer
Const szSOURCE As String = "LabelIt()"
Set MyDb = CurrentDb
'ChtCtl.Requery
'DoEvents
Set Cht = ChtCtl.Object
Set DataSht = Cht.Application.DataSheet
ChartHeight = Cht.Height
ChartWidth = Cht.Width
Stg = ChtCtl.RowSource
Stg = Left(Stg, Len(Stg) - 1) ' Remove last ;
OrderPos = InStr(Stg, "ORDER BY")
SQLStg = Left(Stg, OrderPos - 1) & "WHERE SpaceTypeID = " & Ctl
SQLStg = SQLStg & " " & Mid(Stg, OrderPos) & ";"
Set SpaceAllocationSet = MyDb.OpenRecordset(SQLStg)
'Cht.HasDataTable = True
Cht.Application.DataSheet.Range("A1").Value = 50 ' Need to feed it some
data to create a plot area
ChtCtl.Requery
Set ChtSeries = Cht.SeriesCollection(1)
ChtSeries.MarkerStyle = xlMarkerStyleX
ChtSeries.MarkerSize = 4
ChtSeries.MarkerForegroundColorIndex = 3 ' Red
ChtSeries.MarkerBackgroundColorIndex = xlColorIndexNone
NoPoints = ChtSeries.Points.Count
Call SysCmd(acSysCmdInitMeter, "Labeling " & NoPoints & " points",
NoPoints)
With SpaceAllocationSet
'Loop through each data label and set its
'Top, Left, and Font properties
For lCount = 1 To NoPoints
Set pntDataPoint = ChtSeries.Points(lCount)
Err.Clear
If pntDataPoint.HasDataLabel = True Then
' Add the data label and position it if necessary.
Set ChtLabel = pntDataPoint.DataLabel
' Set format of label
ChtLabel.Caption = !SpaceAndName
ChtLabel.Position = xlLabelPositionCenter
ChtLabel.Font.Size = 7
ChtLabel.Font.Name = "Arial"
ChtLabel.Font.Bold = False
' Set angle
LblAngle = !LabelAngle
' Change it's angle if forced
LblAngle = 1
If LblAngle <> 0 Then
ChtLabel.Orientation = LblAngle
Else
ChtLabel.Orientation = !StdLabOrientation
End If
' Get Top & Left position of label
LabelTop = ChtLabel.Top
LabelLeft = ChtLabel.Left
Debug.Print ChtLabel.Caption & " Xpos: " & !Xpos & " YPos: "
& !Ypos & " LableTop: " & LabelTop & " " & "LabelLeft: " & LabelLeft
GoTo A
' Move labels over the edge to the bottom right of the chart.
' This fails, so the new top gives the label height and the new
left gives the label width
ChtLabel.Top = ChartHeight
ChtLabel.Left = ChartWidth
LabelHeight = ChartHeight - ChtLabel.Top
LabelWidth = ChartWidth - ChtLabel.Left
LabelBottom = ChartHeight - LabelHeight - LabelTop
' Calculate where the point actually is
PointXValue = LabelLeft + (LabelWidth / 2) ' Half way
across the label
PointYValue = LabelTop + (LabelHeight / 2) ' Half way
down the label
' Move so that bottom left is next to point
ChtLabel.Left = PointXValue
ChtLabel.Top = PointYValue - LabelHeight
'Debug.Print ChtLabel.Caption
A:
.MoveNext
End If
'.MoveNext
Call SysCmd(acSysCmdUpdateMeter, lCount)
Next
'Next
.Close
Set SpaceAllocationSet = Nothing
End With
LabelIt_Exit:
LabelIt = True
Call SysCmd(acSysCmdRemoveMeter)
Exit Function
LabelIt_Err:
If Err.Number <> glHANDLED_ERROR Then Err.Description = Err.Description
& " (" & szSOURCE & ")"
If bCentralErrorHandler(False) Then
Stop
Resume
Else
Resume LabelIt_Exit
End If
End Function
LabelLeft: 74
5 - Stokoe. Xpos: 31 YPos: 18
LableTop: 256 LabelLeft: 147
4 - Neale (Wizard) 12' launch. Xpos: 38 YPos: 18 LableTop: 256
LabelLeft: 151
3 - Hale. Xpos: 48 YPos: 18
LableTop: 256 LabelLeft: 229
2 - Chalmers. Xpos: 55 YPos: 18 LableTop:
256 LabelLeft: 253
1 - Jenkins (Preciouss) Jewel. Xpos: 65 YPos: 18 LableTop: 256
LabelLeft: 273
I am trying to program a chart object within Access ( & struggling)
I am using the following code, sorry it's a bit long, but there is a chunk
that is not run (Goto A)
I get a scatter chart with a level of red crosses from this data and a row
of labels very nearly level (1 degree off just to check some code) Why is
there the great anomaly (and error) for the first LabelTop result of 157
while the rest are 256.
Function LabelIt(ChtCtl As Control, Ctl As Control) As Boolean
Dim Cht As Graph.Chart
Dim ChtSeries As Series
Dim ChtLabel As DataLabel
Dim ChtArea As ChartArea
Dim DataSht As DataSheet
Dim pntDataPoint As Point
Dim MyDb As Database
Dim SpaceAllocationSet As Recordset
Dim SQLStg As String, Stg As String
Dim OrderPos As Long
Dim lCount As Long
Dim NoPoints As Long
Dim ChartHeight As Long, ChartWidth As Long
Dim LabelHeight As Long, LabelWidth As Long
Dim LabelTop As Long, LabelLeft As Long, LabelBottom As Long
Dim PointXValue As Long, PointYValue As Long
Dim LblAngle As Integer
Const szSOURCE As String = "LabelIt()"
Set MyDb = CurrentDb
'ChtCtl.Requery
'DoEvents
Set Cht = ChtCtl.Object
Set DataSht = Cht.Application.DataSheet
ChartHeight = Cht.Height
ChartWidth = Cht.Width
Stg = ChtCtl.RowSource
Stg = Left(Stg, Len(Stg) - 1) ' Remove last ;
OrderPos = InStr(Stg, "ORDER BY")
SQLStg = Left(Stg, OrderPos - 1) & "WHERE SpaceTypeID = " & Ctl
SQLStg = SQLStg & " " & Mid(Stg, OrderPos) & ";"
Set SpaceAllocationSet = MyDb.OpenRecordset(SQLStg)
'Cht.HasDataTable = True
Cht.Application.DataSheet.Range("A1").Value = 50 ' Need to feed it some
data to create a plot area
ChtCtl.Requery
Set ChtSeries = Cht.SeriesCollection(1)
ChtSeries.MarkerStyle = xlMarkerStyleX
ChtSeries.MarkerSize = 4
ChtSeries.MarkerForegroundColorIndex = 3 ' Red
ChtSeries.MarkerBackgroundColorIndex = xlColorIndexNone
NoPoints = ChtSeries.Points.Count
Call SysCmd(acSysCmdInitMeter, "Labeling " & NoPoints & " points",
NoPoints)
With SpaceAllocationSet
'Loop through each data label and set its
'Top, Left, and Font properties
For lCount = 1 To NoPoints
Set pntDataPoint = ChtSeries.Points(lCount)
Err.Clear
If pntDataPoint.HasDataLabel = True Then
' Add the data label and position it if necessary.
Set ChtLabel = pntDataPoint.DataLabel
' Set format of label
ChtLabel.Caption = !SpaceAndName
ChtLabel.Position = xlLabelPositionCenter
ChtLabel.Font.Size = 7
ChtLabel.Font.Name = "Arial"
ChtLabel.Font.Bold = False
' Set angle
LblAngle = !LabelAngle
' Change it's angle if forced
LblAngle = 1
If LblAngle <> 0 Then
ChtLabel.Orientation = LblAngle
Else
ChtLabel.Orientation = !StdLabOrientation
End If
' Get Top & Left position of label
LabelTop = ChtLabel.Top
LabelLeft = ChtLabel.Left
Debug.Print ChtLabel.Caption & " Xpos: " & !Xpos & " YPos: "
& !Ypos & " LableTop: " & LabelTop & " " & "LabelLeft: " & LabelLeft
GoTo A
' Move labels over the edge to the bottom right of the chart.
' This fails, so the new top gives the label height and the new
left gives the label width
ChtLabel.Top = ChartHeight
ChtLabel.Left = ChartWidth
LabelHeight = ChartHeight - ChtLabel.Top
LabelWidth = ChartWidth - ChtLabel.Left
LabelBottom = ChartHeight - LabelHeight - LabelTop
' Calculate where the point actually is
PointXValue = LabelLeft + (LabelWidth / 2) ' Half way
across the label
PointYValue = LabelTop + (LabelHeight / 2) ' Half way
down the label
' Move so that bottom left is next to point
ChtLabel.Left = PointXValue
ChtLabel.Top = PointYValue - LabelHeight
'Debug.Print ChtLabel.Caption
A:
.MoveNext
End If
'.MoveNext
Call SysCmd(acSysCmdUpdateMeter, lCount)
Next
'Next
.Close
Set SpaceAllocationSet = Nothing
End With
LabelIt_Exit:
LabelIt = True
Call SysCmd(acSysCmdRemoveMeter)
Exit Function
LabelIt_Err:
If Err.Number <> glHANDLED_ERROR Then Err.Description = Err.Description
& " (" & szSOURCE & ")"
If bCentralErrorHandler(False) Then
Stop
Resume
Else
Resume LabelIt_Exit
End If
End Function