Attaching VB functions to a report

J

JH40

Registered User.
Local time
Today, 05:40
Joined
Sep 16, 2010
Messages
100
I am calculating working days in a report and would like to have the result auto populate to a text box when the report is generated. Since I do not know how to write the VB for this, I am pasting in the following code (found by many google searches). How do I attach this code result to the text box on Form Load?

Option Compare Database

Option Explicit

Public Function Calculate_Working_Days(ByVal dDate1 As Date, ByVal dDate2 As Date, _
ByVal FirstDayOfWeek As DayConstants, Optional WeekLengh As Integer = 5) As Long
' Calculating how many working days in the given interval'
Dim i As Integer
Dim intDayDifference As Integer
Dim dSmallestDate As Date


'Looking for the smallest date from the 2 we give to the function'
If DateDiff("d", dDate1, dDate2) < 0 Then
dSmallestDate = dDate2
Else
dSmallestDate = dDate1
End If

'Geting the interval between the dates in days'
intDayDifference = DateDiff("d", dDate1, dDate2)

'Going trough the interval and looking for the working days'
For i = 0 To Abs(intDayDifference)
If Weekday(dSmallestDate + i, FirstDayOfWeek) < WeekLengh + 1 Then ' looking for the first 5 days from the given'
' day as begining of the week if it is true '
' we count them as working '
Calculate_Working_Days = Calculate_Working_Days + 1 ' if we found one we sum 1 more'
End If
Next i


End Function


Thank you!
 
On load, all you need to do is make an assignment, like this:
Code: 
me.textbox = Calculate_Working_Days(date1, date2)
One more thing about your function: The simple "+i" addition that you are using to add days to the start date and checking the week is not always compatible with vba. I have used numbers to add days before and it has returned a different data type randomly. Using it many times subsequently might pose a problem. I'm not sure 100% though.

If you want something that may be a little more compatible, this is what I use. It applies to the American workweek though:
Code: 
Function EDateDiffBus(sDate As Date, _
                      eDate As Date)

On Error GoTo Cleanup

'******************************************************************************
'
'sDate > Start Date.  If invalid, procedure will not return a value.          *
'eDate > End Date.  If omitted, today's date will be used.                    *
'                                                                             *
'******************************************************************************

Dim ctr As Integer
Dim ctr2 As Integer

Dim qDiff As Long
Dim wDiff As Long 
Dim tExcluded As Long

Dim hDates(4) As Date
Dim hDatesExt(4) As String
Dim TempDate As Date

If sDate = eDate Then
    EDateDiffBus = IIf(Weekday(sDate) = 7, 0, _
                   IIf(Weekday(sDate) = 1, 0, 1))
        GoTo Cleanup
End If
    If sDate = 0 Then
       GoTo Cleanup 
    End If
        If eDate = 0 Then
           eDate = Date
        End If

hDates(0) = DateSerial(Right(Date, 4), 1, 1) 'NEW YEARS DAYS
hDates(1) = DateSerial(Right(Date, 4), 7, 4) 'INDEPENDENCE DAY
hDates(2) = DateSerial(Right(Date, 4), 11, 11) 'VETERANS DAY
hDates(3) = DateSerial(Right(Date, 4), 12, 25) 'CHRISTMAS DAY

hDatesExt(0) = "MLK"
hDatesExt(1) = "MEM"
hDatesExt(2) = "LABOR"
hDatesExt(3) = "THANKS"

  qDiff = Abs(DateDiff("d", sDate, eDate)) + 1
    
    If qDiff > 2 Then
    
        tExcluded = IIf(Weekday(sDate) = 7, _
                        IIf(Weekday(eDate) = 7, 3, _
                            IIf(Weekday(eDate) = 1, 2, 2)), _
                    IIf(Weekday(sDate) = 1, _
                        IIf(Weekday(eDate) = 7, 4, _
                            IIf(Weekday(eDate) = 1, 3, 3)), _
                    IIf(Weekday(eDate) = 7, 3, _
                        IIf(Weekday(eDate) = 1, 2, 2))))
    
    Else 
    
        tExcluded = IIf(Weekday(sDate) = 7, 2, _
                    IIf(Weekday(sDate) = 6, 1, _
                    IIf(Weekday(sDate) = 1, 1, _
                    0)))

    End If

For ctr = 0 To 3
   
   For ctr2 = Year(sDate) To Year(eDate)
   
      If Left(hDates(ctr), Len(hDates(ctr)) - 4) & CStr(ctr2) >= sDate And _
         Left(hDates(ctr), Len(hDates(ctr)) - 4) & CStr(ctr2) <= eDate Then
            tExcluded = tExcluded + 1
      End If
      
         Select Case hDatesExt(ctr)
         
            Case "MLK" 'MARTIN LUTHER KING DAY EXCLUSION
               
               TempDate = IIf(Weekday("1/15/" & CStr(ctr2)) = 2, _
                                      "1/15/" & CStr(ctr2), _
                                    IIf(Weekday("1/16/" & CStr(ctr2)) = 2, _
                                      "1/16/" & CStr(ctr2), _
                                    IIf(Weekday("1/17/" & CStr(ctr2)) = 2, _
                                      "1/17/" & CStr(ctr2), _
                                    IIf(Weekday("1/18/" & CStr(ctr2)) = 2, _
                                      "1/18/" & CStr(ctr2), _
                                    IIf(Weekday("1/19/" & CStr(ctr2)) = 2, _
                                      "1/19/" & CStr(ctr2), _
                                    IIf(Weekday("1/20/" & CStr(ctr2)) = 2, _
                                      "1/20/" & CStr(ctr2), _
                                    IIf(Weekday("1/21/" & CStr(ctr2)) = 2, _
                                      "1/21/" & CStr(ctr2), 0)))))))
               
                  If TempDate >= sDate And TempDate <= eDate Then
                     tExcluded = tExcluded + 1
                  End If
            
            Case "MEM" 'MEMORIAL DAY EXCLUSION
            
               TempDate = IIf(Weekday("5/31/" & CStr(ctr2)) = 2, _
                                      "5/31/" & CStr(ctr2), _
                                    IIf(Weekday("5/30/" & CStr(ctr2)) = 2, _
                                      "5/30/" & CStr(ctr2), _
                                    IIf(Weekday("5/29/" & CStr(ctr2)) = 2, _
                                      "5/29/" & CStr(ctr2), _
                                    IIf(Weekday("5/28/" & CStr(ctr2)) = 2, _
                                      "5/28/" & CStr(ctr2), _
                                    IIf(Weekday("5/27/" & CStr(ctr2)) = 2, _
                                      "5/27/" & CStr(ctr2), _
                                    IIf(Weekday("5/26/" & CStr(ctr2)) = 2, _
                                      "5/26/" & CStr(ctr2), _
                                    IIf(Weekday("5/25/" & CStr(ctr2)) = 2, _
                                      "5/25/" & CStr(ctr2), 0)))))))
   
                  If TempDate >= sDate And TempDate <= eDate Then
                     tExcluded = tExcluded + 1
                  End If
   
            Case "LABOR" 'LABOR DAY EXCLUSION
            
               TempDate = IIf(Weekday("9/1/" & CStr(ctr2)) = 2, _
                                      "9/1/" & CStr(ctr2), _
                                    IIf(Weekday("9/2/" & CStr(ctr2)) = 2, _
                                      "9/2/" & CStr(ctr2), _
                                    IIf(Weekday("9/3/" & CStr(ctr2)) = 2, _
                                      "9/3/" & CStr(ctr2), _
                                    IIf(Weekday("9/4/" & CStr(ctr2)) = 2, _
                                      "9/4/" & CStr(ctr2), _
                                    IIf(Weekday("9/5/" & CStr(ctr2)) = 2, _
                                      "9/5/" & CStr(ctr2), _
                                    IIf(Weekday("9/6/" & CStr(ctr2)) = 2, _
                                      "9/6/" & CStr(ctr2), _
                                    IIf(Weekday("9/7/" & CStr(ctr2)) = 2, _
                                      "9/7/" & CStr(ctr2), 0)))))))
   
                  If TempDate >= sDate And TempDate <= eDate Then
                     tExcluded = tExcluded + 1
                  End If
   
            Case "THANKS" 'THANKSGIVING DAY EXCLUSION
   
               TempDate = IIf(Weekday("11/22/" & CStr(ctr2)) = 5, _
                                      "11/22/" & CStr(ctr2), _
                                    IIf(Weekday("11/23/" & CStr(ctr2)) = 5, _
                                      "11/23/" & CStr(ctr2), _
                                    IIf(Weekday("11/24/" & CStr(ctr2)) = 5, _
                                      "11/24/" & CStr(ctr2), _
                                    IIf(Weekday("11/25/" & CStr(ctr2)) = 5, _
                                      "11/25/" & CStr(ctr2), _
                                    IIf(Weekday("11/26/" & CStr(ctr2)) = 5, _
                                      "11/26/" & CStr(ctr2), _
                                    IIf(Weekday("11/27/" & CStr(ctr2)) = 5, _
                                      "11/27/" & CStr(ctr2), _
                                    IIf(Weekday("11/28/" & CStr(ctr2)) = 5, _
                                      "11/28/" & CStr(ctr2), 0)))))))
   
                  If TempDate >= sDate And TempDate <= eDate Then
                     tExcluded = tExcluded + 1
                  End If
            
         End Select
   
   Next ctr2
      
Next ctr
        
        wDiff = Abs(DateDiff("ww", sDate, eDate)) - 1
            EDateDiffBus = qDiff - tExcluded - (2 * wDiff)

Cleanup:
    ctr = 0
    ctr2 = 0
    qDiff = 0
    wDiff = 0
    tExcluded = 0
    TempDate = 0

End Function
 
Thank you for your response--just getting back to this. I am a novice at VBA, so I'm not yet following the attachment mentioned:

me.textbox = Calculate_Working_Days(date1, date2)
How do I attach this to say, text box 65 on report load (I think I would need to see exactly what the code should be typed as)? Is me.textbox the actual text to type? Sorry--I really don't know VBA.

Thanks!
 
JH40 said:
How do I attach this to say, text box 65 on report load
Click to expand...
a textbox control source is what you want.

the load event really is not related. in that property, write:
Code: 
=functionName(argument1, argument2)
make sense?

as an example, in the function i posted for you, if you have two other boxes on the report and one has the start date, the other the end date, and the sources of the two are "start" and "end", your tBox would have this control source:
Code: 
=EDateDiffBus([start], [end])
 
Thank you again for your help. I'm attaching a test database where I've included all the above, but there is something wrong. I'm hoping it will stand out to those who are fluent with VBA. If you wouldn't mind taking a look at this for me and helping me get in working order, I'd be forever grateful. For me this is like performing surgery for the first time without proper training. :-) Ok, maybe not that serious...

Thanks!
 

Attachments

You must log in or register to reply here.

Similar threads

C
Open report without printing
Replies
13
Views
858
June7
June7
E
Generating report on a dynamic subform
Replies
6
Views
398
The_Doc_Man
The_Doc_Man
N
Solved VBA on timer in MS Access
Replies
9
Views
592
Albert D. Kallal
A
H
Solved Sum of 3 columns sort by 3 diff. dates
Replies
7
Views
692
Ken Sheridan
Ken Sheridan
C
Solved Functionality differences between .accdb and .accde
Replies
11
Views
876
gemma-the-husky
gemma-the-husky

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Back
Top Bottom