Dynamic Legend for Access 2003 Year Planner

[franc sutherland]

Hello,
I have been using Peter Hibbs excellent Flex Grid demo as a wall
planner showing holidays and shutdown days. I have used the legen to
show a different colour on a day depending on which staff member is on
holiday that day.

My issue is developing a dynamic colour legen for the wall planner. I
have managed to make a static colour legend showing the employees name
and their colour next to their name using rectangles. (In the employee
table there is a field storing a unique colour code (e.g.255 for red)
for each employee). There is also a tool which allows the user to
change the colour for each employee.

However, if anyone joins the company or leaves the company, I would
have to manually change the colour legend in the form. I want to find
a way to do this dynamically. So, if an employee is set to inactive,
they no longer show in the colour key, or when a new employee is added
they automatically pop up in the legend.

My first thought was a continuous subform based on 'active'
employees. This is fine and I can make a legend which displays the
active employee names and their colour code entry (the number). The
colour code is different for each employee. How do I graphically
represent these colours in a rectangle or other object to achieve the
colour legend look?

Thanks,

Franc.

[Phil]

Are you talking about conditionally formatting each record in your subform
according to the colour code entry, if so, I can probably help, buts it's
long winded and there is a Bug that has to be "got round" There is also a
limit on 50 colours theoretically, but because of the Bug you are limited to
47 colours. How many employees are involved? Phil

[franc sutherland]

Hi Phil,
That is exactly it, conditionally formatting an object (in this case a
rectangle) in the subform according to the colour code entry in that
row. 47 colours would be plenty, there are currently 10 employees and
it is unlikely that it would exceed 20 employees in the foreseeable
future. I'd love to see your solution if possible.
Thanks, Franc.

[Phil]

OK Frank, I warned you this is hairy

I have a continuous form CalendarNames
One of the controls is text Box - CalendarColour bound to a field in a table
which is the colour, so If I wanted the text box to be red then the field
woud vontain 255.

Here is the code for the form

Private Sub Form_Current()

CalendarColour.BackStyle = 1 ' Normal
Call SetFormatCond(Me, "CalendarColour", "CalendarColour", True)

CalendarColour.BackColor = Nz(CalendarColour)

End Sub

Simple

Now the hairy bit

Sub SetFormatCond(Frm As Form, FldToColour As String, _
FldColourInfo Info As String, ChangeForeColour As Boolean, Optional Criteria
As String) ' Conditional formatting
' Frm is target form,
' FldToColour is the field to which to apply the conditional formatting
' FldColourInfo holds the RGB colour code (Long)
' ChangeForeColour, if true, tries to give a contrasting ForeColor

Dim FormatCond As FormatCondition
Dim i As Long

On Error GoTo SetFormatCond_Err

'Remove existing format conditions but due to an Access bug, if you have
' less than 4 formats, the FormatConditions.Add wont work.
' There is a limit of 3 formats otherwise
Do Until Frm(FldToColour).FormatConditions.Count = 4
Frm(FldToColour).FormatConditions(1).Delete
Loop

' Add the new formats, starting at number 4
With Frm.RecordsetClone
If Nz(Criteria) > "" Then ' Criteria passed
.FindFirst Criteria
Do Until .NoMatch
Set FormatCond = Frm(FldToColour).FormatConditions.Add _
(acExpression, , "[" & FldColourInfo & "] = " _
& Nz(Frm.RecordsetClone(FldColourInfo)))
.FindNext Criteria
Loop
Else
.MoveFirst
Do Until .EOF
Set FormatCond = Frm(FldToColour).FormatConditions.Add _
(acExpression, , "[" & FldColourInfo & "] = " _
& Nz(Frm.RecordsetClone(FldColourInfo)))
.MoveNext
Loop
End If
.Close
End With

i = 4 ' Ignore the first 4 formats

With Frm.RecordsetClone
If Nz(Criteria) > "" Then ' Criteria passed
.FindFirst Criteria
Do Until .NoMatch
If Not IsNull(Frm.RecordsetClone(FldToColour)) Then
Frm(FldToColour).FormatConditions(i).BackColor = _
Nz(Frm.RecordsetClone(FldColourInfo))
If If ChangeForeColour = True Then ' Contrasting ForColor
Frm(FldToColour).FormatConditions(i).ForeColor = _
Contrast(Nz(Frm.RecordsetClone(FldColourInfo)))
End If
Else
Frm(FldToColour).FormatConditions(i).BackColor = _
Frm(FldToColour).FormatConditions(1).BackColor
If If ChangeForeColour = True Then ' Contrasting ForColor
Frm(FldToColour).FormatConditions(i).ForeColor = _
Contrast(Frm(FldToColour).FormatConditions(1).BackColor)
rmatConditions(1).BackColor) End If
End If
i = i + 1
.FindNext Criteria
Loop
Else
.MoveFirst
Do Until .EOF
If Not IsNull(Frm.RecordsetClone(FldToColour)) Then
Frm(FldToColour).FormatConditions(i).BackColor = _
Nz(Frm.RecordsetClone(FldColourInfo))
If If ChangeForeColour = True Then ' Contrasting ForColor
Frm(FldToColour).FormatConditions(i).ForeColor = _
Contrast(Nz(Frm.RecordsetClone(FldColourInfo)))
End If
Else
Frm(FldToColour).FormatConditions(i).BackColor = _
Frm(FldToColour).FormatConditions(1).BackColor
If If ChangeForeColour = True Then ' Contrasting ForColor
Frm(FldToColour).FormatConditions(i).ForeColor = _
Contrast(Frm(FldToColour).FormatConditions(1).BackColor)
rmatConditions(1).BackColor) End If
End If
i = i + 1
.MoveNext
Loop
End If
.Close
End With

Exit Sub

SetFormatCond_Err:
MsgBox gBox "Set Format Conditions error Number: " & Err.Number & " " &
Err.Description

End Sub

unction Contrast(ColIn As Long) As Long

Dim iHue As Long
Dim iSat As Long
Dim iLum As Long
Dim iRed As Long
Dim iBlue As Long
Dim iGreen As Long

iHue = GetHSL(ColIn, 1)
iSat = GetHSL(ColIn, 3) ' Note Order
iLum = GetHSL(ColIn, 2) ' Note Order

iRed = GetRGB(ColIn, 1)
iGreen = GetRGB(ColIn, 2)
iBlue = GetRGB(ColIn, 3)

' Special situations
If iBlue > 250 Then
If iRed < 150 And iGreen < 150 Then
Contrast = vbYellow
Exit Function
End If
End If

If iSat < 100 Then ' Greyish
Contrast = vbBlack
Exit Function
End If

Contrast rast = ((ColIn Xor &HFFFFFF) And &HFFFFFF) Or (ColIn) And (Not
&HFFFFFF)

End Function

Function GetRGB(RGBval As Long, Num As Integer) As Integer

' Check if Num, RGBval are valid.
If Num > 0 And Num < 4 And RGBval > -1 And RGBval < 16777216 Then
GetRGB = RGBval \ 256 ^ (Num - 1) And 255
Else
' Return True (-1) if Num or RGBval are invalid.
GetRGB = True
End If

End Function

MOST IMPORTANT
Due to a Bug, you need to manually set up 3 conditional formats for your
textbox. Doesn't matter what they are as they will be ignored.

Hope this helps, and everything is there. If not, we'll have to try something
else

Phil

[Phil]

On 01/05/2012 15:38:00, "Phil" wrote:
> On 01/05/2012 12:09:47, franc sutherland wrote:
>> On Apr 27, 8:57 pm, "Phil" <p...@stantonfamily.co.uk> wrote:
>>> On 27/04/2012 15:36:00, franc sutherland wrote:
>>>
>>>
>>>
>>> > Hello,
>>> > I have been using Peter Hibbs excellent Flex Grid demo as a wall
>>> > planner showing holidays and shutdown days.  I have used the legen to
>>> > show a different colour on a day depending on which staff member is on
>>> > holiday that day.
>>>

Incidentally, I meant to mention that I designed a very fancy month planner a
few months ago, even did a help file for it. Then my son, cleaver little
bu..er, said Dad, why don't you use Google Calendars? I compromised. Google
Calendars worked fine, as I needed to share the information with my
colleagues. We use it for holidays, room bookings, sailing events etc.
Problem came when we wanted specific information printed out in a specific
way. For example, our Club produces a year book, and we wanted all the
sailing events listed in one section, all the social events in another
section. Then we wanted such things as a “What’s on Next month” list to go in
the dining room. Obvious way to do this is to use Access reports. So I wrote
a routine that read the Google Calendar, imported it into Access (not a
particularly elegant routine, but it works) and was then able to generate
whatever I liked. Access equally has the wall planner calendar format

Phil

[franc sutherland]

Hi Phil,

Thanks for that. I am having a problem with it though.

It is erroring on the line:

Frm(FldToColour).FormatConditions(1).Delete

and the error is Run-Time Error 7966
The format condition number you specified is greater than the number
of format conditions.

Also, the function GetHSL was missing.

Thanks,

Franc.

[Phil]

> Hi Phil,
>
> Thanks for that. I am having a problem with it though.
>
> It is erroring on the line:
>
> Frm(FldToColour).FormatConditions(1).Delete
>
> and the error is Run-Time Error 7966
> The format condition number you specified is greater than the number
> of format conditions.
>
> Also, the function GetHSL was missing.
>
> Thanks,
>
> Franc.
>

Ok, not surprised

Simple bit first

Public Declare Function ColorRGBToHLS Lib "shlwapi.dll" _
(ByVal (ByVal clrRGB As Long, pwHue As Long, pwLuminance As Long,
pwSaturation As Long) As Long

Function GetHSL(ColIn As Long, Num As Byte) As Long

Dim iHue As Long
Dim iSat As Long
Dim iLum As Long

'**********************************************************
' *** NOTE THIS GIVES OUTPUT IN THE ORDER HUE, LUM, SAT ***
'**********************************************************

ColorRGBToHLS ColIn, iHue, iLum, iSat
Select Case Num
Case 1
GetHSL = iHue
Case 2
GetHSL = iLum
Case 3
GetHSL = iSat
Case Else
MsgBox "Error"
End Select

End Function

I think the funtions that are missing iare to do with a routine to set a
contrasting forecolour. Quite frankly, as far as I know, there is no way of
doing this scientifically. It's easy to contrast Red & Green or Blue &
Yellow, but what contrasts with grey? You may or may not need that part of
the code.

Now to the problem

Have you manually added 3 conditional formats to the control you want to
format?

Phil

[franc sutherland]

Hi Phil,
Yes, I have added three conditional formats to the textbox control
Thanks for the functions.
Franc.

[franc sutherland]

On May 9, 3:46 pm, franc sutherland <franc.sutherl...@googlemail.com>
wrote:

Hi Phil,
Still got the same issue. Any ideas?
Thanks,
Franc.

[Phil]

>
> Hi Phil,
> Still got the same issue. Any ideas?
> Thanks,
> Franc.
>

Frank, I think I lied to you

Try manually adding 4 conditional formats, not 3 as I said before.
Some things seem to start their count at 0, some start at 1, all very
confusing

Phil

[franc sutherland]

Hi Phil,
When I try to add a fourth conditional format using VBA I get the 7966
run-time error, the format condition you specified is greater than the
number of format conditions.
Franc.

[Phil]

Hi Frank

The word was maunually.
On the format tab select conditional formating
You can use pretty well rubbish expressions
Try 4 formats like
Expression is [EmployeeID] = 123 Then some format or none, it doesn't matter
Expression is [EmployeeID] = 1234 Then some format or none, it doesn't matter
Expression is [EmployeeID] = 12345 Then some format or none, it doesn't
matter Expression is [EmployeeID] = 123456 Then some format or none, it
doesn't matter

That manually has set up the required 4 formats

Let me know how you get on

Phil

[franc sutherland]

Hi Phil,
Sorry about that, I think of manually as using code.
After entering a third condition in the Conditional Formatting dialog
box, the Add button becomes greyed out.
How do I add a fourth?
Cheers,
Franc.

[Phil]

Hi Franc
What version of Access are you using?
I think Access 2007 allowed up to 50 conditional formats, certainly Access
2010 which I use, does allows 50, but there appears to be a bug that unless
you have set up the 4 conditional formats already (hence my suggestion that
you add the 4 formats manually), you can't add more formats using VBA.
Equally when you delete the format conditions using code, you must still
leave the first 4 conditions Phil

[franc sutherland]

Hi Phil,
This is for an application in Access 2003.
Franc.

[Phil]

>
> Hi Phil,
> This is for an application in Access 2003.
> Franc.
>

Sorry Franc AFIK it can't be done in the earlier versions.

Shame, I actually use a year planner program, working different colours for
types of event (eg dining room bookings, committee room bookings, Dinghy
races cruiser races, training, holidays etc) rather than your requirement for
Employees, but it works fine. As a side issue, I have partially integrated it
with Google Calendars, in that it downloads the data from Google Calendars.
Makes it simple to print reports in exactly the required format. If you like,
I could email you a screen shot, but it will have to be done pretty well
straight away, as I may be without a computer for a while.

Phil

[franc sutherland]

Hi Phil,
That's a shame, looks like we'll need to move on to Access 2010.
Thanks for your offer of the Google Calendar screenshot but I don't
think it'll be relevant in this scenario.
Thanks again for your help and if this application moves on to Access
2010 I'll implement your method to get the dynamic legend.
Cheers,
Franc.