I have a form for calculating fees for members. I have attched the layout of form in word attachment.The code is given below:
Option Compare Database
Option Explicit
Private Sub AmountDue_GotFocus()
If IsNull(Me.FeePeriod) Then Me.FeePeriod.SetFocus
End Sub
Private Sub FeePeriod_AfterUpdate()
If Me.NewRecord Then
Dim dbs As Database, rst As Recordset, mpart As Integer
Dim mpart1 As Integer, mnth As Integer, memsubs As Integer, criterion As String
Dim x As Long, m As String, str As String, Y As Integer, x1 As Long
x = 0
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("Fees Maintenance", DB_OPEN_DYNASET)
'NO RECORD IS YET ENTERED IN FEE MAINTAINENCE TABLE
If rst.BOF Then
Call PeriodFrom
Call PeriodTo(Me.Parent!JoinDate)
Else
'RECORD IS ALREADY ENTERED IN FEE MAINTAINENCE TABLE
rst.MoveFirst
criterion = "Memnum=" & Me.Parent!MemNum
rst.FindLast criterion
'RECORD CORRESPONDING TO SAME MEMNUM IS ALREADY ENTERED IN FEE MAINTAINENCE TABLE
If rst.NoMatch = False Then
'IF RECEIVED AMOUNT FIELD IS NULL
If IsNull(rst!Received_Amt) Then
MsgBox "Please fill in the Received Amount first!"
Exit Sub
End If
'IF RECEIVED AMOUNT FIELD IS NOT NULL AND RECORD CORRESPONDING TO SAME MEMNUM IS ALREADY ENTERED IN FEE MAINTAINENCE TABLE
x = rst!BalanceAmt
m = MonthName(Month(rst!FromDate))
Y = Year(rst!FromDate)
MsgBox "first m=" & m
Me.FromDate = rst!ToDate + 1
Call PeriodTo(Me.FromDate)
'RECORD CORRESPONDING TO SAME MEMNUM IS NOT ALREADY ENTERED IN FEE MAINTAINENCE TABLE IE FIRST TIME ENTRY
Else
Call PeriodFrom
Call PeriodTo(Me.Parent!JoinDate)
End If
End If
If Not IsNull(Me.FromDate) Then
If (Month(Me.FromDate) <> 4) And (Month(Me.FromDate) <> 10) Then
Me.Received_Amt = 0
Me.Received_Amt.Locked = True
Else
Me.Received_Amt.Locked = False
If (m <> "April") And (m <> "October") And m <> "" Then
str = "(" & Left(m, 3) & Y & "-" & Left(MonthName(Month(Me.ToDate)), 3) & Year(Me.ToDate) & ")"
MsgBox "second m=" & m
Me.Remarks = str
Else
If x < 0 Then
Me.Remarks = "Pending Amount (" & Abs(x) & ")"
Else
If x > 0 Then
Me.Remarks = "Already Paid (" & x & ")"
End If
End If
End If
End If
End If
Me.AmountDue = Me.AmountDue - x
Me.Balance_Amt = Me.Received_Amt - Me.AmountDue
'Me.COMPANY_CODE = DLookup("company_code", "MemMaster", "Memnum=" & Me.Parent!MemNum)
rst.Close
Set dbs = Nothing
Else
Me.Undo
Exit Sub
End If
End Sub
Private Sub Form_BeforeUpdate(Cancel As Integer)
If IsNull(Me.FromDate) Then Me.Undo
End Sub
Function PeriodTo(ByVal DateFrom As Date)
Dim mpart As Integer, mpart1 As Integer, mnth As Integer, memsubs As Integer
Dim criterion As String
mpart = DatePart("m", Me.FromDate)
Select Case mpart
Case 1
'If DatePart("m", Me.FromDate) = 2 Then
'Me.ToDate = DateAdd("m", 3, IIf(Year(Me.FromDate) / 4 - Int(Year(Me.FromDate)) = 0, Me.FromDate - 2, Me.FromDate - 1))
'Else
Me.ToDate = DateAdd("m", 3, Me.FromDate - 1)
'End If
Me.FeePeriod = "Period II" ' even if the user selects by mistake Period I , it will correct
Case 2
Me.ToDate = DateAdd("m", 2, Me.FromDate - 1)
Me.FeePeriod = "Period II"
Case 3
Me.ToDate = DateAdd("m", 1, Me.FromDate) - 1
Me.FeePeriod = "Period II"
Case 4
Me.ToDate = DateAdd("m", 6, Me.FromDate) - 1
Me.FeePeriod = "Period I"
Case 5
Me.ToDate = DateAdd("m", 5, Me.FromDate) - 1
Me.FeePeriod = "Period I"
Case 6
Me.ToDate = DateAdd("m", 4, Me.FromDate) - 1
Me.FeePeriod = "Period I"
Case 7
Me.ToDate = DateAdd("m", 3, Me.FromDate) - 1
Me.FeePeriod = "Period I"
Case 8
Me.ToDate = DateAdd("m", 2, Me.FromDate) - 1
Me.FeePeriod = "Period I"
Case 9
Me.ToDate = DateAdd("m", 1, Me.FromDate - 1)
Me.FeePeriod = "Period I"
Case 10
Me.ToDate = DateAdd("m", 6, Me.FromDate)
Me.ToDate = Me.ToDate - 1
Me.FeePeriod = "Period II"
Case 11
Me.ToDate = DateAdd("m", 5, Me.FromDate - 1)
Me.FeePeriod = "Period II"
Case 12
Me.ToDate = DateAdd("m", 4, Me.FromDate - 1)
Me.FeePeriod = "Period II"
End Select
'**************
If Not IsNull(Me.Parent!p_DOL) Then
If (Me.Parent!p_DOL > Me.FromDate) Then
Me.ToDate = Me.Parent!p_DOL
'ADD HERE
Me.Parent!Status = "STOPPED"
Me.Parent!dol = Me.Parent!p_DOL
'Me.Parent!p_DOL = Null
'Me.Parent!p_DOL.SetFocus
Else
MsgBox (" please enter a value greater than fromdate")
Me.FromDate = Null
Me.ToDate = Null
'Me.Parent!Status = "Stopped"
'Me.Parent!dol = Me.Parent!p_DOL
End If
End If
Dim TotMem As Integer
'commented here tempo
' TotMem = DCount("Company", "MemMaster", "Company='" & Me.Parent!MemName & "'")
Select Case TotMem
Case 1 To 2
Me.AmountDue = 4000 * (DateDiff("m", Me.FromDate, Me.ToDate) + 1)
Case 3 To 5
Me.AmountDue = 5000 * (DateDiff("m", Me.FromDate, Me.ToDate) + 1)
Case 6 To 8
Me.AmountDue = 6000 * (DateDiff("m", Me.FromDate, Me.ToDate) + 1)
Case Is > 9
Me.AmountDue = 7000 * (DateDiff("m", Me.FromDate, Me.ToDate) + 1)
Case Else
Me.AmountDue = 150 * (DateDiff("m", Me.FromDate, Me.ToDate) + 1)
End Select
End Function
Function PeriodFrom()
Dim mpart As Integer, mpart1 As Integer, mnth As Integer, memsubs As Integer
Dim criterion As String, Dpart As Integer
Dpart = DatePart("d", Me.Parent!JoinDate)
Select Case Dpart
Case Is >= 25
Me.FromDate = "01/" & Month(Me.Parent!JoinDate) + 1 & "/" & Year(Me.Parent!JoinDate)
Case Is < 25
Me.FromDate = "01/" & Month(Me.Parent!JoinDate) & "/" & Year(Me.Parent!JoinDate)
End Select
End Function
Private Sub FromDate_GotFocus()
If IsNull(Me.FeePeriod) Then Me.FeePeriod.SetFocus
End Sub
Private Sub Received_Amt_AfterUpdate()
Me.Parent!RECEIPT.Visible = True
Me.Parent!replica = Me.Received_Amt
Me.Balance_Amt = Me.Received_Amt - Me.AmountDue
End Sub
Private Sub ToDate_GotFocus()
If IsNull(Me.FeePeriod) Then Me.FeePeriod.SetFocus
End Sub
Private Sub RECEIPT_Click()
On Error GoTo Err_RECEIPT_Click
Dim stDocName As String
stDocName = "RECEIPT"
DoCmd.OpenReport stDocName, acNormal
Exit_RECEIPT_Click:
Exit Sub
Err_RECEIPT_Click:
MsgBox Err.Description
Resume Exit_RECEIPT_Click
End Sub
Now i want :
An addition list value in FEE PERIOD COMBO BOX "FULL YEAR" should appear only for cases where billing cycle April-Mar is due. (This is for case when a member wants to pay together for 2 periods instead of 1 period).
For example:
If users joining date is on 2nd dec 02 then in this case as apr- billing cycle is due , so fee period list box should show "fee period also" and when that is selected fromdate should display 01 Apr 03 and to date should display 31 mar 04.
Please help!
shikha
If user selects this then in fromdate and todate
Option Compare Database
Option Explicit
Private Sub AmountDue_GotFocus()
If IsNull(Me.FeePeriod) Then Me.FeePeriod.SetFocus
End Sub
Private Sub FeePeriod_AfterUpdate()
If Me.NewRecord Then
Dim dbs As Database, rst As Recordset, mpart As Integer
Dim mpart1 As Integer, mnth As Integer, memsubs As Integer, criterion As String
Dim x As Long, m As String, str As String, Y As Integer, x1 As Long
x = 0
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("Fees Maintenance", DB_OPEN_DYNASET)
'NO RECORD IS YET ENTERED IN FEE MAINTAINENCE TABLE
If rst.BOF Then
Call PeriodFrom
Call PeriodTo(Me.Parent!JoinDate)
Else
'RECORD IS ALREADY ENTERED IN FEE MAINTAINENCE TABLE
rst.MoveFirst
criterion = "Memnum=" & Me.Parent!MemNum
rst.FindLast criterion
'RECORD CORRESPONDING TO SAME MEMNUM IS ALREADY ENTERED IN FEE MAINTAINENCE TABLE
If rst.NoMatch = False Then
'IF RECEIVED AMOUNT FIELD IS NULL
If IsNull(rst!Received_Amt) Then
MsgBox "Please fill in the Received Amount first!"
Exit Sub
End If
'IF RECEIVED AMOUNT FIELD IS NOT NULL AND RECORD CORRESPONDING TO SAME MEMNUM IS ALREADY ENTERED IN FEE MAINTAINENCE TABLE
x = rst!BalanceAmt
m = MonthName(Month(rst!FromDate))
Y = Year(rst!FromDate)
MsgBox "first m=" & m
Me.FromDate = rst!ToDate + 1
Call PeriodTo(Me.FromDate)
'RECORD CORRESPONDING TO SAME MEMNUM IS NOT ALREADY ENTERED IN FEE MAINTAINENCE TABLE IE FIRST TIME ENTRY
Else
Call PeriodFrom
Call PeriodTo(Me.Parent!JoinDate)
End If
End If
If Not IsNull(Me.FromDate) Then
If (Month(Me.FromDate) <> 4) And (Month(Me.FromDate) <> 10) Then
Me.Received_Amt = 0
Me.Received_Amt.Locked = True
Else
Me.Received_Amt.Locked = False
If (m <> "April") And (m <> "October") And m <> "" Then
str = "(" & Left(m, 3) & Y & "-" & Left(MonthName(Month(Me.ToDate)), 3) & Year(Me.ToDate) & ")"
MsgBox "second m=" & m
Me.Remarks = str
Else
If x < 0 Then
Me.Remarks = "Pending Amount (" & Abs(x) & ")"
Else
If x > 0 Then
Me.Remarks = "Already Paid (" & x & ")"
End If
End If
End If
End If
End If
Me.AmountDue = Me.AmountDue - x
Me.Balance_Amt = Me.Received_Amt - Me.AmountDue
'Me.COMPANY_CODE = DLookup("company_code", "MemMaster", "Memnum=" & Me.Parent!MemNum)
rst.Close
Set dbs = Nothing
Else
Me.Undo
Exit Sub
End If
End Sub
Private Sub Form_BeforeUpdate(Cancel As Integer)
If IsNull(Me.FromDate) Then Me.Undo
End Sub
Function PeriodTo(ByVal DateFrom As Date)
Dim mpart As Integer, mpart1 As Integer, mnth As Integer, memsubs As Integer
Dim criterion As String
mpart = DatePart("m", Me.FromDate)
Select Case mpart
Case 1
'If DatePart("m", Me.FromDate) = 2 Then
'Me.ToDate = DateAdd("m", 3, IIf(Year(Me.FromDate) / 4 - Int(Year(Me.FromDate)) = 0, Me.FromDate - 2, Me.FromDate - 1))
'Else
Me.ToDate = DateAdd("m", 3, Me.FromDate - 1)
'End If
Me.FeePeriod = "Period II" ' even if the user selects by mistake Period I , it will correct
Case 2
Me.ToDate = DateAdd("m", 2, Me.FromDate - 1)
Me.FeePeriod = "Period II"
Case 3
Me.ToDate = DateAdd("m", 1, Me.FromDate) - 1
Me.FeePeriod = "Period II"
Case 4
Me.ToDate = DateAdd("m", 6, Me.FromDate) - 1
Me.FeePeriod = "Period I"
Case 5
Me.ToDate = DateAdd("m", 5, Me.FromDate) - 1
Me.FeePeriod = "Period I"
Case 6
Me.ToDate = DateAdd("m", 4, Me.FromDate) - 1
Me.FeePeriod = "Period I"
Case 7
Me.ToDate = DateAdd("m", 3, Me.FromDate) - 1
Me.FeePeriod = "Period I"
Case 8
Me.ToDate = DateAdd("m", 2, Me.FromDate) - 1
Me.FeePeriod = "Period I"
Case 9
Me.ToDate = DateAdd("m", 1, Me.FromDate - 1)
Me.FeePeriod = "Period I"
Case 10
Me.ToDate = DateAdd("m", 6, Me.FromDate)
Me.ToDate = Me.ToDate - 1
Me.FeePeriod = "Period II"
Case 11
Me.ToDate = DateAdd("m", 5, Me.FromDate - 1)
Me.FeePeriod = "Period II"
Case 12
Me.ToDate = DateAdd("m", 4, Me.FromDate - 1)
Me.FeePeriod = "Period II"
End Select
'**************
If Not IsNull(Me.Parent!p_DOL) Then
If (Me.Parent!p_DOL > Me.FromDate) Then
Me.ToDate = Me.Parent!p_DOL
'ADD HERE
Me.Parent!Status = "STOPPED"
Me.Parent!dol = Me.Parent!p_DOL
'Me.Parent!p_DOL = Null
'Me.Parent!p_DOL.SetFocus
Else
MsgBox (" please enter a value greater than fromdate")
Me.FromDate = Null
Me.ToDate = Null
'Me.Parent!Status = "Stopped"
'Me.Parent!dol = Me.Parent!p_DOL
End If
End If
Dim TotMem As Integer
'commented here tempo
' TotMem = DCount("Company", "MemMaster", "Company='" & Me.Parent!MemName & "'")
Select Case TotMem
Case 1 To 2
Me.AmountDue = 4000 * (DateDiff("m", Me.FromDate, Me.ToDate) + 1)
Case 3 To 5
Me.AmountDue = 5000 * (DateDiff("m", Me.FromDate, Me.ToDate) + 1)
Case 6 To 8
Me.AmountDue = 6000 * (DateDiff("m", Me.FromDate, Me.ToDate) + 1)
Case Is > 9
Me.AmountDue = 7000 * (DateDiff("m", Me.FromDate, Me.ToDate) + 1)
Case Else
Me.AmountDue = 150 * (DateDiff("m", Me.FromDate, Me.ToDate) + 1)
End Select
End Function
Function PeriodFrom()
Dim mpart As Integer, mpart1 As Integer, mnth As Integer, memsubs As Integer
Dim criterion As String, Dpart As Integer
Dpart = DatePart("d", Me.Parent!JoinDate)
Select Case Dpart
Case Is >= 25
Me.FromDate = "01/" & Month(Me.Parent!JoinDate) + 1 & "/" & Year(Me.Parent!JoinDate)
Case Is < 25
Me.FromDate = "01/" & Month(Me.Parent!JoinDate) & "/" & Year(Me.Parent!JoinDate)
End Select
End Function
Private Sub FromDate_GotFocus()
If IsNull(Me.FeePeriod) Then Me.FeePeriod.SetFocus
End Sub
Private Sub Received_Amt_AfterUpdate()
Me.Parent!RECEIPT.Visible = True
Me.Parent!replica = Me.Received_Amt
Me.Balance_Amt = Me.Received_Amt - Me.AmountDue
End Sub
Private Sub ToDate_GotFocus()
If IsNull(Me.FeePeriod) Then Me.FeePeriod.SetFocus
End Sub
Private Sub RECEIPT_Click()
On Error GoTo Err_RECEIPT_Click
Dim stDocName As String
stDocName = "RECEIPT"
DoCmd.OpenReport stDocName, acNormal
Exit_RECEIPT_Click:
Exit Sub
Err_RECEIPT_Click:
MsgBox Err.Description
Resume Exit_RECEIPT_Click
End Sub
Now i want :
An addition list value in FEE PERIOD COMBO BOX "FULL YEAR" should appear only for cases where billing cycle April-Mar is due. (This is for case when a member wants to pay together for 2 periods instead of 1 period).
For example:
If users joining date is on 2nd dec 02 then in this case as apr- billing cycle is due , so fee period list box should show "fee period also" and when that is selected fromdate should display 01 Apr 03 and to date should display 31 mar 04.
Please help!
shikha
If user selects this then in fromdate and todate
