problem with code (long code) to fill out backcolor of textboxes.

[Trevoke]

Alright. I'm using Access97, and following this intro is code in my 'calendar' form (thanks FAQs) to fill in each textbox representing a day of the month, AND the code to fill in the box if the strSQL statement returned one or more results. However - it only ever fills up the boxes 2 and 3 or 31 and 32, depending on the month.
----------------------------------

Private Function filldates()
Dim curday As Variant, curbox As Integer

curday = DateSerial(Year(Me![FirstDate]), Month(Me![FirstDate]), 1) 'Get the first day of the chosen month

Do Until DatePart("w", curday, vbSunday) = 1 ' count back til Sunday
curday = DateAdd("d", -1, curday)
Loop

For curbox = 0 To 41 'need to loop through 42 textboxes
Me("D" & curbox) = Day(DateAdd("d", curbox, curday))
Call boxes(curday, curbox)
If Month(DateAdd("d", curbox, curday)) = Month(Me!FirstDate) Then
Me("D" & curbox).Visible = True
Else
Me("D" & curbox).Visible = False
End If
Next curbox

Me.Repaint 'display changes

End Function

---------------------------
And the boxes function to fill in the background.
---------------------------

Public Function boxes(curday As Variant, curbox As Integer)
Dim db1 As Database
Dim rst As Recordset
Dim temp2 As Date
Dim strSQL As String
Dim temp As String

temp2 = DateSerial(Year(Me![FirstDate]), Month(Me![FirstDate]), curbox)
strSQL = "SELECT * FROM tblSummary1 WHERE ShipDate = #" & temp2 & "# OR BatchMakeDate = #" & temp2 & "# OR NYStdDate = #" & temp2 & "# OR NYMassDate = #" & temp2 & "# OR ComponentsDueBy = #" & temp2 & "#;"

Set db1 = CurrentDb
Set rst = db1.OpenRecordset(strSQL)

If rst.RecordCount <> 0 Then
Me(&quot;D&quot; & curbox).BackColor = 2500
End If

End Function


Does anybody know why it fills up those special boxes regardless of whether or not they're filled? Catapultam habeo. Nisi pecuniam omnem mihi dabis, ad caput tuum saxum immane mittam.

 

[Trevoke]

Eventually fixed this after futzing around - a lot - with it. If anyone's interested I can send them the code via e-mail.. Catapultam habeo. Nisi pecuniam omnem mihi dabis, ad caput tuum saxum immane mittam.

 

[MichaelRed]

Hmmmmmmmmmmmm,

I recognize the calendar builder part, but the highlight is i bit NEW. I really have no idea why the posted code doesn't work. I got into the just fixit mode and lost track of some of the changes ... oh well ... on to more obtuse ranblings. Some minor clean up of the style to suit my tired old eyes, and the calendar builder worked almost like the original. Also changed the procedures to accept a form name and a date - just incase someone wanted to do it differently. Also changed the text box names of the date box entries to suit 'my' implementation of the form. Probably should have added that as a passed arg also?

Anyway, on to the highlight. UGLY color selection - but then it isn't mine so why quibble? Again, tired eyes needed to &quot;UnScramble&quot; the Sql to be a bit more readable - but in the end I didn't really change that. I did need to look at the args, and added the form, so it could be more easily referenced. Only real change I made was to reference the (already passed) CurDay (Date) instead of hte awkward rec0nstruction.

Over all, the procedures NEED some error trapping, and the instantiation of the database / recordset on for each date seems woefully inefficient. Otherwise, the following works for me - the call to the basFil* is just in the form Load event with args Me, Date nore elaborate usage would require additional work, such as re-doing the form to change the Month ...

Option Compare Database
Option Explicit
Public Function basFilDates(FrstDt As Date, MyFrm As Form)

    Dim CurDay As Variant
    Dim CurBox As Integer

    'Get the first day of the chosen month
    CurDay = DateSerial(Year(FrstDt), Month(FrstDt), 1)

    'Last Sunday of Previous Month.
    'First, check it is NOT already Sunday
    If (Weekday(CurDay) <> vbSunday) Then
        CurDay = DateAdd(&quot;d&quot;, vbSunday - Weekday(CurDay), CurDay)
    End If

    For CurBox = 1 To 42 'need to loop through 42 textboxes

        MyFrm(&quot;txtDay&quot; & Trim(Str(CurBox))) = Day(CurDay)

        Call basHiLiteBoxes(CurDay, CurBox, MyFrm)

        If Month(CurDay) = Month(FrstDt) Then
            MyFrm(&quot;txtDay&quot; & CurBox).Visible = True
        Else
            MyFrm(&quot;txtDay&quot; & CurBox).Visible = False
        End If

        CurDay = CurDay + 1

    Next CurBox

    MyFrm.Repaint   'display changes

End Function
Public Function basHiLiteBoxes(CurDay As Variant, CurBox As Integer, MyFrm As Form)

    '---------------------------
    'And the boxes function to fill in the background.
    '---------------------------
    Dim dbs As DAO.Database
    Dim rst As DAO.Recordset

'    Dim tmpDt As Date
    Dim strSQL As String

'    tmpDt = DateSerial(Year(FrstDt), Month(FrstDt), CurBox)
    strSQL = &quot;SELECT * &quot;
    strSQL = strSQL & &quot;FROM tblSummary1 &quot;
    strSQL = strSQL & &quot;WHERE ShipDate = #&quot; & CurDay & &quot;# &quot;
    strSQL = strSQL & &quot;OR BatchMakeDate = #&quot; & CurDay & &quot;# &quot;
    strSQL = strSQL & &quot;OR NYStdDate = #&quot; & CurDay & &quot;# &quot;
    strSQL = strSQL & &quot;OR NYMassDate = #&quot; & CurDay & &quot;# &quot;
    strSQL = strSQL & &quot;OR ComponentsDueBy = #&quot; & CurDay & &quot;#;&quot;

    Set dbs = CurrentDb
    Set rst = dbs.OpenRecordset(strSQL)
    
    If (rst.RecordCount <> 0) Then
        MyFrm(&quot;txtDay&quot; & CurBox).BackColor = 2500
    End If

End Function
[code] MichaelRed
m.red@att.net

There is never time to do it right but there is always time to do it over

 

[Trevoke]

Well - thank you for this code (and, well, thanks for the comments on mine - harsh but expected, I have little experience with Access or VB).

The color selection WAS really ugly - then someone told me about vbWhite, vbRed, and the like.. vbRed is much prettier

Well, as it is, I have one week to finish this thing off, so I'll make it efficient if I have the time. For now - it works.. But I know how insanely slow it is.

I think the other way would be to open a recordset and then loop through it for every new date?... If you can think of a more efficient way, feel free to tell me Catapultam habeo. Nisi pecuniam omnem mihi dabis, ad caput tuum saxum immane mittam.

 

[MichaelRed]

Let me count the ways ...

No, I think the counting, like enumeration, is just tedium. Form the brief glance a the data UESD to test do the work, the db structure is somewhat badly de-normalized. You include four fields to list potential events. You could use field names like:

DtFld1; DtFld2; ... DtFldN

Where the 1; 2; ... n is the giveaway clue to the denormallization.

You MAY have 'reason' for this in other concerns, but this part should look like:

DtOccur; Event

From this perspective, a simple select query with start & End dates parameters for the range should return the set necessary for the month being displayed. Using this, youo get several 'advantages':

First, all of the dates events are gathered in ONE instance of the db/rst.

The different events are available -easily, so your calendar display could easily color code the events. You could generically have not just &quot;vbRed&quot; leter days, but vbBlue letter days, vbLtGreen letter days ...

Since you can obtain (and retain) the event list with just the starting date, you don't really need the second function - just set the appropiate backcolor for the event when the date is calculated. Since you are ONLY dealing with the current month's events, you could generate an array in the procedure with an element corresponding to the Day of the month. Use the recorset to fill the array, so that each Day in the array included the &quot;Event Code&quot;. Days w/o events would just remain enpty. In the loop to create the Day numbers, just check the corresponding array element. If it is not empty, use the &quot;event&quot; to set te backcolor as you see fit.

I have lots more advice to give - but it is late, and this doesn't help with my grocery bill, the rent, transportation expensed, ...


MichaelRed
m.red@att.net

There is never time to do it right but there is always time to do it over

 

[Trevoke]

Well.. I drink from the fount of knowledge right now, so if you have anything else you'd daign open my eyes to, I'd probably erect a shrine to you someplace where I see it often

One question: How do you create an array in Access 97? And.. How do you handle it? (parse it, etc etc..)

Thanks for your time. Catapultam habeo. Nisi pecuniam omnem mihi dabis, ad caput tuum saxum immane mittam.

 

[MichaelRed]

For array implementation, look it up in the help. The basics are better explained there than I would do here (but -or course- you need to read 'help-speak' to understand)

MichaelRed
m.red@att.net

There is never time to do it right but there is always time to do it over

 

[Trevoke]

Ok - I got the arrays down. Much simpler than I expected.. C++ simple (I know. My mind works backwards).

Now I'm beginning to grow a few of the ideas you gave me.. It all sounds very interesting. Catapultam habeo. Nisi pecuniam omnem mihi dabis, ad caput tuum saxum immane mittam.