Accesspert
Registered User.
- Local time
- Today, 09:05
- Joined
- Feb 16, 2006
- Messages
- 36
Hi, I've written a VBA code for my evaluation form to add the total. However, it does not work. It does not show me the total as I'm going through the evaluation. Could someone please help me out? This is my code:
Option Compare Database
Option Explicit
Public Const strCYes = "_YES"
Public Const strNo = "_YES_NO"
Public Const strNA = "_NA"
Public Function GET_SCORE()
On Error GoTo GET_SCORE_Err
Dim ctlCurrentControl As Control
Dim strSkill As String
Dim strSkillVal As String
Dim intWeight As Integer
Dim intWeight1 As Integer
Dim intWeight2 As Integer
Dim strYes As String
Dim strYesNo As String
Dim lngCurRec As Long
Set ctlCurrentControl = Screen.ActiveControl
lngCurRec = Forms!frmServiceQualityAssessment!EvaluationKey
strSkill = ctlCurrentControl.ControlSource
strSkillVal = ctlCurrentControl.Value
strYes = strSkill & strCYes
strYesNo = strSkill & strNo
intWeight = DLookup("Weight", "tblEvaluationWeight", "Skill Key = " & "'" & strSkill & "'")
Select Case strSkillVal
Case "N/A"
intWeight1 = 0
intWeight2 = 0
Case "YES"
intWeight1 = intWeight
intWeight2 = intWeight
Case "NO"
intWeight1 = 0
intWeight2 = intWeight
End Select
DoCmd.RunCommand acCmdSaveRecord
Call UPDATE_SCORE(strYes, strYesNo, strSkill, strSkillVal, intWeight1, intWeight2, lngCurRec)
Call SET_OVERALL_RESULT
GET_SCORE_Exit:
Exit Function
GET_SCORE_Err:
Debug.Print "Error in mdlScore " & Err.Number & " :" & Err.Description
Resume GET_SCORE_Exit
End Function
Public Sub UPDATE_SCORE(usYes As String, usYesNo As String, usSkill As String, usSkillType As String, _
usWeight1 As Integer, usWeight2 As Integer, usCurRec As Long)
Dim db As Database
Set db = CurrentDb()
db.Execute "UPDATE tblEvaluation SET " & usYes & "=" & usWeight1 & ", " & usYesNo & "=" & usWeight2 & " " & _
"WHERE EvaluationKey =" & usCurRec
Set db = Nothing
End Sub
Public Function SET_OVERALL_RESULT()
On Error GoTo Open_Error
Dim db As Database
Dim rsOverAll As Recordset
Dim strOverAll As String
Set db = CurrentDb()
Set rsOverAll = db.OpenRecordset("qryScore")
If rsOverAll.RecordCount > 0 Then
strOverAll = rsOverAll.Fields(5)
Forms!frmServiceQualityAssessment.sbfServiceQA!Total = Format(strOverAll / 100, "#.00%")
Else
Forms!frmServiceQualityAssessment.sbfServiceQA!Total = 0
Exit Function
End If
rsOverAll.Close
Set db = Nothing
Exit Function
Open_Error:
Debug.Print "Error opening overall score recordset " & Err.Number & " " & Err.Description
End Function
Option Compare Database
Option Explicit
Public Const strCYes = "_YES"
Public Const strNo = "_YES_NO"
Public Const strNA = "_NA"
Public Function GET_SCORE()
On Error GoTo GET_SCORE_Err
Dim ctlCurrentControl As Control
Dim strSkill As String
Dim strSkillVal As String
Dim intWeight As Integer
Dim intWeight1 As Integer
Dim intWeight2 As Integer
Dim strYes As String
Dim strYesNo As String
Dim lngCurRec As Long
Set ctlCurrentControl = Screen.ActiveControl
lngCurRec = Forms!frmServiceQualityAssessment!EvaluationKey
strSkill = ctlCurrentControl.ControlSource
strSkillVal = ctlCurrentControl.Value
strYes = strSkill & strCYes
strYesNo = strSkill & strNo
intWeight = DLookup("Weight", "tblEvaluationWeight", "Skill Key = " & "'" & strSkill & "'")
Select Case strSkillVal
Case "N/A"
intWeight1 = 0
intWeight2 = 0
Case "YES"
intWeight1 = intWeight
intWeight2 = intWeight
Case "NO"
intWeight1 = 0
intWeight2 = intWeight
End Select
DoCmd.RunCommand acCmdSaveRecord
Call UPDATE_SCORE(strYes, strYesNo, strSkill, strSkillVal, intWeight1, intWeight2, lngCurRec)
Call SET_OVERALL_RESULT
GET_SCORE_Exit:
Exit Function
GET_SCORE_Err:
Debug.Print "Error in mdlScore " & Err.Number & " :" & Err.Description
Resume GET_SCORE_Exit
End Function
Public Sub UPDATE_SCORE(usYes As String, usYesNo As String, usSkill As String, usSkillType As String, _
usWeight1 As Integer, usWeight2 As Integer, usCurRec As Long)
Dim db As Database
Set db = CurrentDb()
db.Execute "UPDATE tblEvaluation SET " & usYes & "=" & usWeight1 & ", " & usYesNo & "=" & usWeight2 & " " & _
"WHERE EvaluationKey =" & usCurRec
Set db = Nothing
End Sub
Public Function SET_OVERALL_RESULT()
On Error GoTo Open_Error
Dim db As Database
Dim rsOverAll As Recordset
Dim strOverAll As String
Set db = CurrentDb()
Set rsOverAll = db.OpenRecordset("qryScore")
If rsOverAll.RecordCount > 0 Then
strOverAll = rsOverAll.Fields(5)
Forms!frmServiceQualityAssessment.sbfServiceQA!Total = Format(strOverAll / 100, "#.00%")
Else
Forms!frmServiceQualityAssessment.sbfServiceQA!Total = 0
Exit Function
End If
rsOverAll.Close
Set db = Nothing
Exit Function
Open_Error:
Debug.Print "Error opening overall score recordset " & Err.Number & " " & Err.Description
End Function