Anarchy

Post Reply New Topic

Private Sub Workbook_Open()
'Error Handling
On Error GoTo HandleError
'Disables Close Button
Application.EnableCancelKey = xlDisabled
'Shows Login Form at Startup
frmLogin.Show

'Error Handling Continued
HandleExit:
    Exit Sub
HandleError:
    MsgBox ("Bzzzt. Error" & Err.Description)
    Resume HandleExit
End Sub

Private Sub cmdDelete_Click()
frmDelete.Show
End Sub

Private Sub cmdDeposit_Click()
frmDepositGate.Show
End Sub

Private Sub cmdLogout_Click()
Unload Me
End Sub

Private Sub cmdNew_Click()
frmNew.Show
End Sub

Private Sub cmdShutdown_Click()
ThisWorkbook.Save
End
End Sub

Private Sub cmdWithdraw_Click()
frmWithdrawGate.Show
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = 0 Then Cancel = True
End Sub

Private Sub cmdBack_Click()
Unload Me
End Sub
Private Sub cmdProceed_Click()
'Error Handling
On Error GoTo HandleError

If Len(txtName) <> 0 Then
    If Len(txtPassword1) <> 0 Then
        If Len(txtPassword2) <> 0 Then
           
        Else
            MsgBox ("Please re-type Admin password")
            Exit Sub
        End If
    Else
        MsgBox ("Please type the Admin password")
        Exit Sub
    End If
Else
    MsgBox ("Please enter a name")
    Exit Sub
End If
Sheet1.Unprotect
Range("A1").Select
ActiveCell.Offset(0, 1).Select
Do
    ActiveCell.Offset(1, 0).Select
Loop Until ActiveCell.Text = "Admin Account"
ActiveCell.Offset(0, 1).Select
If txtPassword1.Value = ActiveCell Then
    If txtPassword2.Text = txtPassword1.Text Then
        strOldName = txtName.Text
    Else
        MsgBox ("Passwords do not match")
        Exit Sub
    End If
Else
    MsgBox ("Incorrect Password")
    Exit Sub
End If
Range("A1").Select
Do
    ActiveCell.Offset(1, 0).Select
Loop Until ActiveCell.Text = strOldName
ActiveCell.Value = ""
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = ""
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = ""
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = ""
MsgBox ("Account Deleted")
txtName.Text = ""
txtPassword1.Text = ""
txtPassword2.Text = ""
txtName.SetFocus
Sheet1.Protect

'Error Handling Continued
HandleExit:
    Exit Sub
HandleError:
    MsgBox ("Bzzzt. Error" & Err.Description)
    Range("A1").Select
    Resume HandleExit
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = 0 Then Cancel = True
End Sub

Private Sub cmdBack_Click()
Unload Me
End Sub

Private Sub cmdProceed_Click()
'Error Handling
On Error GoTo HandleError

'Validation
If Len(txtName.Value) <> 0 Then
    If Len(txtAmount.Value) <> 0 Then
   
    Else
        MsgBox ("Please enter amount")
        Exit Sub
    End If
Else
    MsgBox ("Please enter Student Name")
    Exit Sub
End If

'This performs the Deposit
DepositName = txtName.Text
DepositAmount = txtAmount.Text
Sheet1.Unprotect
Range("A1").Select
Do
    ActiveCell.Offset(1, 0).Select
Loop Until ActiveCell.Value = txtName
ActiveCell.Offset(0, 3).Select
ActiveCell.Value = ActiveCell.Value + txtAmount.Value
strAmountLeft = ActiveCell.Text
MsgBox (txtName & " 's current balance is £" & ActiveCell.Text)
'This calls the function which prints the Deposit Receipt
Call Deposit_Receipt
Sheet1.Protect

'Error Handling Continued
HandleExit:
    Exit Sub
HandleError:
    MsgBox ("Bzzzt. Error" & Err.Description)
    Range("A1").Select
    Resume HandleExit
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = 0 Then Cancel = True
End Sub

Private Sub cmdLogin_Click()
'Error Handling
On Error GoTo HandleError

'This is used for the validation function
blnUserFound = False
blnTypeFound = False
blnPasswordFound = False
blnAdmin = False
'This checks to see if the boxes are empty.
If Len(txtUserName) <> 0 Then
    If Len(cboAccountType) <> 0 Then
       If Len(txtPassword) <> 0 Then
        strUserName = txtUserName.Text
        strAccountType = cboAccountType.Text
        strPassword = txtPassword.Text
        Else
            MsgBox ("Please enter your password")
            Exit Sub
            End If
    Else
        MsgBox ("Please select an Account Type")
        Exit Sub
    End If
Else
    MsgBox ("Please enter your Username")
    Exit Sub
End If
Call Interest
Call Login_1

'Error Handling Continued
HandleExit:
    Exit Sub
HandleError:
    MsgBox ("Bzzzt. Error" & Err.Description)
    Resume HandleExit
End Sub

Private Sub UserForm_Activate()
cboAccountType.AddItem "Student Account"
cboAccountType.AddItem "Admin Account"

End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = 0 Then Cancel = True
End Sub


Private Sub cmdAdd_Click()
'Error Handling
On Error GoTo HandleError

'Checks to see if user has entered no data
If Len(txtName) <> 0 Then
    If Len(cboAccountType) <> 0 Then
        If Len(txtPassword1) <> 0 Then
            If Len(txtPassword2) <> 0 Then
                If txtPassword2.Value = txtPassword1.Value Then
                    strNewName = txtName.Text
                    strNewAccountType = cboAccountType.Text
                    strNewPassword = txtPassword1.Text
                Else
                    MsgBox ("The passwords you typed don't match")
                    Exit Sub
                End If
            Else
                MsgBox ("Please re-type the password")
                Exit Sub
            End If
        Else
            MsgBox ("Please enter a passsword")
            Exit Sub
        End If
    Else
        MsgBox ("Please select an Account Type")
        Exit Sub
    End If
Else
    MsgBox ("Please enter a name")
    Exit Sub
End If
'Finds empty cell
Range("A1").Select
Do
    ActiveCell.Offset(1, 0).Select
Loop Until ActiveCell.Value = ""
'Adds entry
Sheet1.Unprotect
ActiveCell.Value = strNewName
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = strNewAccountType
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = strNewPassword
'Resets form
Sheet1.Protect
txtName.Text = ""
cboAccountType.Text = ""
txtPassword1.Text = ""
txtPassword2.Text = ""
txtName.SetFocus

'Error Handling Continued
HandleExit:
    Exit Sub
HandleError:
    MsgBox ("Bzzzt. Error" & Err.Description)
    Range("A1").Select
    Resume HandleExit
End Sub
Private Sub cmdBack_Click()
Unload Me
End Sub
Private Sub UserForm_Initialize()
cboAccountType.AddItem "Admin Account"
cboAccountType.AddItem "Student Account"
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = 0 Then Cancel = True
End Sub

Private Sub cmdLogout_Click()
Unload Me
End Sub

Private Sub cmdWithdraw_Click()
frmWithdrawGate.Show
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = 0 Then Cancel = True
End Sub
Private Sub cmdBack_Click()
Unload Me
End Sub

Private Sub cmdProceed_Click()
'Error Handling
On Error GoTo HandleError
'Validation
If Len(txtName.Value) <> 0 Then
    If Len(txtPassword.Value) <> 0 Then
        If Len(txtWithdraw.Value) <> 0 Then
           
        Else
            MsgBox ("Please enter a value")
            Exit Sub
        End If
    Else
        MsgBox ("Please enter Password")
        Exit Sub
    End If
Else
    MsgBox ("Please enter a name")
    Exit Sub
End If
WithdrawName = txtName.Text
WithdrawPassword = txtPassword.Text
WithdrawAmount = txtWithdraw.Text
Sheet1.Unprotect
Range("A1").Select
Do
    ActiveCell.Offset(1, 0).Select
Loop Until ActiveCell.Value = txtName
ActiveCell.Offset(0, 2).Select
If ActiveCell.Value = txtPassword Then
    ActiveCell.Offset(0, 1).Select
    If ActiveCell.Value <> 0 Then
        ActiveCell.Value = ActiveCell.Value - txtWithdraw.Text
        strNewAmount = ActiveCell.Text
        MsgBox (txtName & " 's current balance is £" & ActiveCell.Text)
        Call Credit_Note
    Else
        MsgBox ("Insufficient Funds")
        Sheet1.Protect
        Exit Sub
    End If
Else
    MsgBox ("Please enter a password")
    Sheet1.Protect
    Exit Sub
End If
'Error Handling Continued
HandleExit:
    Sheet1.Protect
    Exit Sub
HandleError:
    MsgBox ("Bzzzt. Error. " & Err.Description)
    Resume HandleExit
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = 0 Then Cancel = True
End Sub

Function Deposit_Receipt()
'Error Handling
On Error GoTo HandleError

Dim objWord As Word.Application
MsgBox ("Printing Receipt")

'Create the variable objects that references the
'Microsoft Word object model
Dim oWord As Word.Application
Dim oDoc As Word.Document
Set oWord = CreateObject("Word.Application")

oWord.Documents.Add (ThisWorkbook.Path & "\Deposit Receipt.dot")

'Show the document you have created
oWord.Visible = True

With oWord.ActiveDocument.Bookmarks
    .Item("UserName").Range.Text = DepositName
    .Item("AmountDeposited").Range.Text = DepositAmount
    .Item("AmountLeft").Range.Text = strAmountLeft
End With

'Print the document
oWord.PrintOut

'Tidy up the objects you have created
Set oDoc = Nothing
Set oWord = Nothing

'Error Handling Continued
HandleExit:
    Exit Function
HandleError:
    MsgBox ("Bzzzt. Error" & Err.Description)
    Resume HandleExit
End Function

Function Credit_Note()
'Error Handling
On Error GoTo HandleError

Dim objWord As Word.Application
MsgBox ("Printing Receipt")

'Create the variable objects that reference the
'Microsoft Word object model
Dim oWord As Word.Application
Dim oDoc As Word.Document
Set oWord = CreateObject("Word.Application")

oWord.Documents.Add (ThisWorkbook.Path & "\Credit Note Template.dot")

'Show the document you have created
oWord.Visible = True

With oWord.ActiveDocument.Bookmarks
    .Item("UserName").Range.Text = WithdrawName
    .Item("AmountWithdrawn").Range.Text = WithdrawAmount
    .Item("AmountLeft").Range.Text = strNewAmount
End With

'Print the document
oWord.PrintOut

'Tidy up the objects you have created
Set oDoc = Nothing
Set oWord = Nothing
'Error Handling Continued
HandleExit:
    Exit Function
HandleError:
    MsgBox ("Bzzzt. Error" & Err.Description)
    Resume HandleExit
End Function

Public DepositName As String
Public DepositAmount As String
Public WithdrawName As String
Public WithdrawPassword As String
Public WithdrawAmount As String
Public CurrentAmount As String
Public strNewAmount As String
Public strAmountLeft As String
Public strUserName As String
Public strAccountType As String
Public strPassword As String
Public blnUserFound As Boolean
Public blnTypeFound As Boolean
Public blnPassword As Boolean
Public blnAdmin As Boolean
Public strNewName As String
Public strNewAccountType As String
Public strNewPassword As String
Public strOldName As String
Public Date_1, Day_1 As Date

Function Login_1()
On Error GoTo HandleError

Sheet1.Unprotect
For Each objCell In Range("UserName")
    If objCell.Value = strUserName Then
        blnUserFound = True
        Exit For
    End If
Next
If blnUserFound = True Then
    MsgBox ("UserName Found")
Else
    MsgBox ("UserName not found")
    Exit Function
End If
objCell.Select
ActiveCell.Offset(0, 1).Select
If ActiveCell.Value = strAccountType Then
    MsgBox ("Correct Account Type")
    blnTypeFound = True
    If strAccountType = "Admin Account" Then
        blnAdmin = True
    Else
       
    End If
Else
    MsgBox ("Incorrect Account Type")
    Exit Function
End If
ActiveCell.Offset(0, 1).Select
If ActiveCell.Value = strPassword Then
    MsgBox ("Correct Password")
    blnPassword = True
Else
    MsgBox ("Incorrect Password")
    Exit Function
End If
Sheet1.Protect
If blnAdmin = True Then
    MsgBox ("Welcome" & strUserName)
    frmLogin.txtUserName.Text = ""
    frmLogin.cboAccountType.Text = ""
    frmLogin.txtPassword.Text = ""
    frmAdmin.Show
Else
    MsgBox ("Welcome " & strUserName)
    frmStudent.Show
    frmLogin.txtUserName.Text = ""
    frmLogin.cboAccountType.Text = ""
    frmLogin.txtPassword.Text = ""
End If
HandleExit:
    Exit Function
HandleError:
    MsgBox ("Bzzzt. Error" & Err.Description)
    Resume HandleExit
End Function

Function Interest()
On Error GoTo HandleError

Date_1 = Date
Day_1 = Day(Date_1)
If Day_1 = 1 Then
    Sheet1.Unprotect
    Range("D2").Select
    Do
        ActiveCell.Value = ActiveCell.Value + (ActiveCell.Value / 100 / 2)
        ActiveCell.Offset(1, 0).Select
    Loop Until ActiveCell.Value = ""
    Sheet1.Protect
Else
    Exit Function
Sheet1.Protect
End If

HandleExit:
    Exit Function
HandleError:
    MsgBox ("Bzzzt. Error" & Err.Description)
    Resume HandleExit
End Function