View Single Post
  #18   Report Post  
Posted to microsoft.public.excel.programming
Peter T Peter T is offline
external usenet poster
 
Posts: 5,600
Default Positioning datalabels

Hi Phil,

It is still bugging me that it is quicker to call Excel from Access,

output
11 charts and link them back to my Access form than it is to create one
chart in Access.


So why not work with Excel, don't know if you can embed an Excel object,
otherwise automate and use the copyPicture approach to maintain chart image
where you need it in Access.

would be interested to see your revised code.


I wonder if you will be after seeing it!

Create an XY scatter or ordinary Line type, play with all the various Axis
options in the Scale tab (X-axis options are different in Scatter vs
non-Scatter), include both +ve & -ve X & Y values

Option Explicit

Sub testGetPointCoords()
Dim i As Long
Dim cht As Chart
Dim arrPoints(), arrColours()
Dim x As Long

'ActiveSheet.Calculate
Set cht = ActiveSheet.ChartObjects(1).Chart

If GetPointCoords(cht, arrPoints) = 0 Then ', 1

' cht.Lines.Delete

x = 24 ' 16 or 24 if automatic colours

For i = LBound(arrPoints) To UBound(arrPoints)
ArrowsToPoints cht, arrPoints(i), srIdx:=i, clrIdx:=x + i
Next
End If
End Sub

Function GetPointCoords(cht As Chart, vPointCoords(), _
Optional nFrom As Long, Optional nTo As Long) As Long
' vPointCoords returns as an array of arrays of XY coords
' nFrom & nTo the series to process
' (if nFrom = 0 get point coords in all series)

' Handles XY scatter and normal Line types on primary axes
' (both X & Y primary axes must exist)
' also handles single 1D column type but
' more to do to cater for multiple columns on the X between labels
' at present all Y's will be right but all X's on or in middle of labels)

Dim bXbetweenCats As Boolean
Dim bCatLabels As Boolean
Dim i As Long, srIdx As Long
Dim nRevX As Long, nRevY As Long ' ReversePlotOrder 1 or -1

Dim axMax As Double, axMin As Double
Dim aX_MaxMin As Double, aY_MaxMin As Double

Dim x0 As Double, y0 As Double ' our co-ord base
Dim xf As Double, yf As Double ' scale factors
Dim xP As Single, yP As Single ' point co-ord

Dim halfCat As Double ' 0 or 0.5
Dim arrX, arrY

Dim sr As Series
Dim aX As Axis, aY As Axis

Dim bDebug As Boolean
bDebug = True

On Error GoTo errH

Set aX = cht.Axes(1)
Set aY = cht.Axes(2)

x0 = aX.Left
y0 = aY.Top + aY.Height

If aX.ReversePlotOrder Then nRevX = -1 Else nRevX = 1
If aY.ReversePlotOrder Then nRevY = -1 Else nRevY = 1

On Error Resume Next

bXbetweenCats = aX.AxisBetweenCategories

If Err.Number < 0 Then
' must be a scatter (is the definate ?)
On Error GoTo errH
axMax = aX.MaximumScale
axMin = aX.MinimumScale
aX_MaxMin = IIf(nRevX = 1, aX.MaximumScale, aX.MinimumScale)

Else
bCatLabels = True ' not a scatter

axMax = UBound(aX.CategoryNames) - 1
If bXbetweenCats Then
axMax = axMax + 1
halfCat = 0.5 * nRevX
End If

End If

On Error GoTo errH

aX_MaxMin = IIf(nRevX = -1, axMax, axMin)
aY_MaxMin = IIf(nRevY = -1, aY.MaximumScale, aY.MinimumScale)

'scale factor Y
xf = aX.Width / (axMax - axMin)

'scale factor Y
yf = aY.Height / (aY.MaximumScale - aY.MinimumScale)

If bCatLabels Then
' maybe re-adjust aX_MaxMin for the calc in the loop
If nRevX = 1 Then
aX_MaxMin = 1
ElseIf Not bXbetweenCats Then ' And nRevX = -1
aX_MaxMin = aX_MaxMin + 1
End If
End If

If nFrom = 0 Then
nFrom = 1: nTo = cht.SeriesCollection.Count
ElseIf nTo = 0 Then
nTo = nFrom
End If

ReDim vPointCoords(nFrom To nTo)

For srIdx = nFrom To nTo
Set sr = cht.SeriesCollection(srIdx)

With sr
ReDim arrXYcoord(0 To 1, 1 To .Points.Count) As Single
arrX = .XValues
arrY = .Values

If UBound(arrX) < UBound(arrY) Then
Err.Raise 20200, , "Fewer X points than Y points"
End If

For i = 1 To .Points.Count

If bCatLabels Then arrX(i) = i

xP = x0 + (arrX(i) - aX_MaxMin + halfCat) * xf * nRevX
yP = y0 - (arrY(i) - aY_MaxMin) * yf * nRevY

arrXYcoord(0, i) = xP
arrXYcoord(1, i) = yP

Next

End With

vPointCoords(srIdx) = arrXYcoord

Next

Exit Function

errH:
If bDebug Then
If MsgBox(Err.Description & vbCr & "Stop & Resume ?", vbYesNo) _
= vbYes Then
Stop
Resume
End If
Else
MsgBox Err.Description
End If

GetPointCoords = Err.Number

End Function

Function ArrowsToPoints(cht As Chart, aXY, srIdx As Long, _
Optional clrIdx As Long)
' down to right arrows over points
Dim sName As String
Dim sh As Shape
Dim i As Long
Const ARROW_HW As Single = 18

For i = 1 To UBound(aXY, 2)
sName = "S" & srIdx & "_P" & i
On Error Resume Next
Set sh = Nothing
Set sh = cht.Shapes(sName)
On Error GoTo 0
If sh Is Nothing Then
Set sh = cht.Shapes.AddLine(aXY(0, i), aXY(1, i), _
aXY(0, i) - ARROW_HW, aXY(1, i) - ARROW_HW)

sh.Line.BeginArrowheadStyle = msoArrowheadTriangle
sh.Line.EndArrowheadLength = msoArrowheadLengthMedium
sh.Line.EndArrowheadWidth = msoArrowheadWidthMedium
sh.Name = sName

Else
With sh
If Abs(.Left - (aXY(0, i) - ARROW_HW)) 0.25 Then _
.Left = aXY(0, i) - ARROW_HW
If Abs(.Top - (aXY(1, i) - ARROW_HW)) 0.25 Then _
.Top = (aXY(1, i) - ARROW_HW)
If Abs(.Width - ARROW_HW) 0.25 Then .Width = ARROW_HW
If Abs(.Height - ARROW_HW) 0.25 Then .Height = ARROW_HW
If Not .HorizontalFlip = msoTrue Then _
.Flip msoFlipHorizontal
End With
End If

If clrIdx < 0 Then
With sh.Line.ForeColor
If .SchemeColor < 7 + clrIdx Then
.SchemeColor = 7 + clrIdx
End If
End With
End If
Next

On Error Resume Next
For i = i To cht.Shapes.Count
Set sh = Nothing
Set sh = cht.Shapes("S" & srIdx & "_P" & i)
If Not sh Is Nothing Then
sh.Delete
End If
Next

End Function


In this approach XY coordinates may be a few points adrift. A different
earlier approach was a bit more accurate though more work. Main difference
is the above uses entire width & height of the axes as basis for the scale
factors. The other approach only uses to one side of the axes' intersection
point. I suspect the reason is, for say the X-axis, it's more accurate to
define with Y-Axis.left rather than X-Axis.Left which might not be exactly
where anticipated.

Another problem is not reliable with non-100% zoom. It seems a bit odd and
flakey how internal dimensions are returned.

Regards,
Peter T




"Phil Stanton" wrote in message
...
Hi Peter

would be interested to see your revised code.

It is still bugging me that it is quicker to call Excel from Access,

output
11 charts and link them back to my Access form than it is to create one
chart in Access.

Thanks

Phil
"Peter T" <peter_t@discussions wrote in message
...
Afraid the code I posted was incomplete to say the least, although would
be
OK with a typical Scatter chart with no values to below or to left of

the
respective axes.

For my own interest I did a bit more to cater for the above and other
alignment/order options for axes, and also for non scatter charts, ie

with
labels rather than X values. FWIW it seems reasonably reliable to work

out
point coordinates on a chart.

Regards,
Peter T



"Phil Stanton" wrote in message
et...

Hi Peter

Thanks for code it works just fine, but is I resize the chart the label
positions go wrong.

Think I will abandon the project and just have to live with the Excel
version

Many thanks for your help thoug

Phil


"Peter T" <peter_t@discussions wrote in message
...
From what you described yesterday about how slow that MS Graph have

you
considered automating Excel (from Access), updating your Excel chart

then
transferring an image of the chart via the clipboard onto an image

control
on your Access display.

Try Stephen Bullen's PastePicture.xls which you'll find zipped on

this
page
http://www.oaltd.co.uk/Excel/Default.htm

It looks more complicated than it is, it should all work pretty fast
for
you.

I don't know VBA in Access, I assume it does not directly expose a
Clipboard
object but if it does you are in luck, you'd only need two lines of
code
instead of the main module from PastePicture.

Regards,
Peter T

PS, since my last post I now realise there are other ways to get

those
label
sizes simply by moving to various preset positions around their

respective
points - perhaps you get what I'm thinking of.



"Phil Stanton" wrote in message
et...
Thanks

will have a look at it later

The annoying thing is I have an Excel program that extracts the data

held
in
Access and works perfectly ( and quickly). I then show the GIF file

that
Excel generates back in the Access form. Trouble is I am a purist

and
want
to see a chart update dynamically as I change the Access data.

If you would like to see the GIF file generated from Excel I can

email
it
to
you

Thanks again

Phil
"Peter T" <peter_t@discussions wrote in message
...
If for example I want to place a particular label exactly over a
point,

I know that's not your real question but if that was, simply
ActiveChart.SeriesCollection(1).DataLabels.Positio n =
xlLabelPositionCenter

But if I follow, your real question is how to get the XY

coordinates
of
your
XY points. Have a go with the following

Create an XY embedded chart with one series, keep it simple let

each
X:Y
make a straight line starting with X:Y = 0:0, 1:1 etc

Option Explicit
Sub test()
Dim i As Long
Dim cht As Chart
Dim sr As Series
Dim aX As Axis, aY As Axis
Dim x0 As Single, y0 As Single, xP As Single, yP As Single
Dim xf As Double, yf As Double
Dim arrX, arrY

Set cht = ActiveSheet.ChartObjects(1).Chart
Set aX = cht.Axes(1)
Set aY = cht.Axes(2)

x0 = aY.Left + aY.Width
y0 = aX.Top + aX.Height

yf = y0 - aY.Top
xf = (aX.Left + aX.Width - x0)

xf = (aX.Left + aX.Width - x0) / (aX.MaximumScale)
yf = (y0 - aY.Top) / aY.MaximumScale

Set sr = cht.SeriesCollection(1)
With sr
arrX = .XValues
arrY = .Values
For i = 1 To .Points.Count
xP = x0 + arrX(i) * xf
yP = y0 - arrY(i) * yf
With .DataLabels(i)
.Left = xP
.Top = yP
End With
Next
End With

End Sub

I know yesterday you said you are working with an MS Graph, I

think
it
should work pretty much the same way but try the above in Excel.

First
with
a straight line, then your "difficult" data.

The idea is to create your own co-ord system centred in the
intersection
of
the XY axes, then scale X & Y according to the length to right and
above
the
intersection. Where a chart does not have either of those axes
would
use
the plot-area instead.

I'll leave the hard part to you, as to how to work out quite where
to
place
those labels on a crowded chart. Actually I'd be interested to

see!

Almost forgot to say, for some reason data labels don't seem to

expose
there
width & height properties, hence in this demo top-left label

corners
are
placed over points (if it works as intended). I imagine you'll be

able
to
guesstimate sizes depending on text & font, otherwise there's a

much
more
long winded way to get a good idea of the size.

Regards,
Peter T



"Phil Stanton" wrote in message
et...
I have a scatter chart and I want to be able to position the

labels
differently for each point ( depending on the space available on
the
chart)

I know the X & Y co-ordinates of the points in the series.

The chart is 622 point wide and the interior width of the plot

area
is
422
point wide. I know the height and width of the label

If for example I want to place a particular label exactly over a
point,
what
is the calculation using the X co-ordinate, widths to give me the
DataLabel.Left value

Thanks for any help

Phil