Access_Page

Personal Page

Code for Form Security

Cut Cost After Update Sub (Using a Case Staement)

Validation of a TaxCard

Code listed on this page is for your viewing and use Please
SCROLL DOWN

Home

Personal Page

My Personal Page





		Option Compare Database Private Sub cmdChange_Click() Me.lblPassword.Visible = True Me.lblUserid.Visible = True Me.Password.Visible = True Me.UserId.Visible = True End Sub Private Sub cmdEnter_Click() '============================================================== ' Selects user information from employee table passed to ' global variables for different purposes thru the application 'and for use with security '=============================================================== Dim rs As Recordset Dim db As Database Dim Sql As String Dim rsPWD As String Dim rsID As String Dim txtPWD As String Dim txtID As String On Error GoTo cmdEnter_error txtID = Me.txtUserId txtPWD = Me.txtPassword Sql = "select tblemployee.password,tblemployee.userid," _ & "tblEmployee.Name,tblemployee.group " _ & "from tblemployee where tblemployee.password = " _ & "'" & txtPWD & "' and tblemployee.userid = '" & txtID & "'" Set db = CurrentDb Debug.Print Sql Set rs = db.OpenRecordset(Sql) rsID = rs(0) rsPWD = rs(1) glbName = rs(2) glbGroup = rs(3) rs.Close db.Close If rsID = txtPWD And rsPWD = txtID Then Me.lblChange.Visible = True Me.cmdChange.Visible = True Me.cmdMainMenu.Visible = True cmdMainMenu.SetFocus End If Me.lblName.Caption = glbName cmdEnter_exit: Exit Sub cmdEnter_error: If rsID = "" And rsPWD = "" Then MsgBox Err.Description Resume cmdEnter_exit Else MsgBox Err.Description '"You have entered an invalid UserId or Password Try Again" Resume cmdEnter_exit End If End Sub Private Sub cmdMainMenu_Click() '========================== 'minimizes active screen 'opens form mainmenu '========================== Dim stDocName As String On Error GoTo Err_cmdMainMenu_Click stDocName = "MainMenu" DoCmd.OpenForm stDocName Me.Visible = False Exit_cmdMainMenu_Click: Exit Sub Err_cmdMainMenu_Click: MsgBox Err.Description Resume Exit_cmdMainMenu_Click End Sub Private Sub cmdExit_Click() '==================== 'Exits application '==================== On Error GoTo Err_cmdExit_Click DoCmd.Quit Exit_cmdExit_Click: Exit Sub Err_cmdExit_Click: MsgBox Err.Description Resume Exit_cmdExit_Click End Sub Private Sub Form_Activate() '==================================== 'sets different values to fields when 'user returns to this form '==================================== Me.txtUserId.BackColor = vbWhite Me.txtPassword.BackColor = vbWhite Me.txtPassword.ForeColor = vbWhite Me.UserId.BackColor = vbWhite Me.Password.BackColor = vbWhite Me.Password.ForeColor = vbWhite Me.lblChange.Visible = False Me.lblPassword.Visible = False Me.lblUserid.Visible = False Me.Password.Visible = False Me.UserId.Visible = False Me.cmdChange.Visible = False End Sub Private Sub Form_Load() '=========================================== 'sets values to different controls based on 'security information returned from text 'entered by user. Controls back color of 'active text box '============================================ Me.txtUserId.BackColor = vbWhite Me.txtPassword.BackColor = vbWhite Me.txtPassword.ForeColor = vbWhite Me.UserId.BackColor = vbWhite Me.Password.BackColor = vbWhite Me.Password.ForeColor = vbWhite Me.lblChange.Visible = False Me.lblPassword.Visible = False Me.lblUserid.Visible = False Me.Password.Visible = False Me.UserId.Visible = False Me.cmdChange.Visible = False Me.cmdMainMenu.Visible = False End Sub

	Private Sub chkCut_AfterUpdate() '************************************************** 'Retrieves the value of the length of the steel 'with the following variables retrieved from the user '************************************************** Length = Round((Round(Me.Feet * 12, 2)) + Round(Me.txLinches, 2) + Round(Me.txtNum / Me.txtDenum, 2), 2) If Me.chkCut = -1 Then Select Case Length ' A Case Staatement to find what cut cost to use Case Is < 72 Let Me.[3'TO6'].Value = "YES" Me.BD3TO6 = -1 Let Me.[6'TO8'].Value = "NO" Me.BD6TO8 = 0 Me.LineCutCost = Round((Me.Pieces * 2.5), 2) Case Is <= 96 Me.BD3TO6 = 0 Me.BD6TO8 = -1 Me.LineCutCost = Round((Me.Pieces * 1.5), 2) Case Else Let Me.[3'TO6'].Value = "NO" Me.BD3TO6 = 0 Let Me.[6'TO8'].Value = "NO" Me.BD6TO8 = 0 Me.LineCutCost = 0 End Select Else Let Me.[3'TO6'].Value = "NO" Let Me.[6'TO8'].Value = "NO" Me.BD3TO6 = 0 Me.BD6TO8 = 0 Me.LineCutCost = 0 End If End Sub

			Private Sub cmdFirst_Click() '========================================================= 'accepts a date, extracts the year to compare with the 'present year to see if taxcard is valid, sets warnings 'to be recongnized by user then moves to first record '========================================================= On Error GoTo Err_cmdFirst_Click DoCmd.GoToRecord , , acFirst Dim year As Integer Dim datePresent As Integer year = DatePart("yyyy", Me.TaxCard_Date) datePresent = DatePart("yyyy", Now()) 'INVALID SET RED If year < datePresent Then Let Me.TaxCard_Date_Label.BackColor = vbRed Let Me.TaxCard.Value = False Let Me.lblTaxCard.ForeColor = vbRed 'VALID set white Else Let Me.TaxCard_Date_Label.BackColor = vbWhite Let Me.TaxCard.Value = True Let Me.lblTaxCard.ForeColor = 10040115 End If Exit_cmdFirst_Click: Exit Sub Err_cmdFirst_Click: MsgBox Err.Description Resume Exit_cmdFirst_Click End Sub

Hosted by www.Geocities.ws