ClassRecordsV1 - Visual Basic Code

Initial Setup	Attendance Sheet
Forms	Student Report

Initial Setup

Option Explicit
Dim Counter
Dim CounterTwo
Dim ValueHolder
Dim RangeHolder
Dim SaveAsFileName
Dim ApplPath
Dim Msg

Private Sub CommandButton1_Click()

'Copy Class Times to Attendance Page
Counter = 5
CounterTwo = 42
Do While Counter < 10
RangeHolder = "B" & Counter
ValueHolder = Range(RangeHolder).Value
RangeHolder = "B" & CounterTwo
Sheet1.Range(RangeHolder).Value = ValueHolder
Counter = Counter + 1
CounterTwo = CounterTwo + 1
Loop

' Copy Student Names to Attendance Page and Load ComboBox1 on Student Report Page with Student Names
Sheet2.ComboBox1.Clear
Counter = 5
Do While Counter < 35
RangeHolder = "F" & Counter
ValueHolder = Range(RangeHolder).Value
RangeHolder = "A" & Counter
Sheet1.Range(RangeHolder).Value = ValueHolder
If ValueHolder <> "" Then
Sheet2.ComboBox1.AddItem ValueHolder
End If
Counter = Counter + 1
Loop

Sheet2.ComboBox1.Text = "Select A Student"

'Set A1 cells to Class Name
Sheets("initial setup").Select
Range("B13").Select
ValueHolder = ActiveCell.Value
Sheets("Attendance").Select
Sheets("Attendance").Range("A1").Select
ActiveCell.Value = ValueHolder & " Student Register"
Sheets("Student Report").Select
Sheets("Student Report").Range("A1").Select
ActiveCell.Value = ValueHolder & " Student Report"
Sheets("Attendance Statistics").Select
Sheets("Attendance Statistics").Range("A1").Select
ActiveCell.Value = ValueHolder & " Attendance Statistics"
Sheets("Late Details").Select
Sheets("Late Details").Range("A1").Select
ActiveCell.Value = ValueHolder & " Late Details"

If Sheet1.Range("FR4").Value <> 1 Then
SaveAsFileName = ValueHolder & " Student Register"
ApplPath = CurDir
SaveAsFileName = ApplPath & "\Class Records\" & ValueHolder & " Student Register"
The above line should be changed to ' SaveAsFileName = ApplPath & "\ClassRecords\Class Records\" & ValueHolder & " Student Register" ' for the MS Excell 2003 version.
ThisWorkbook.SaveAs (SaveAsFileName)
Sheet1.Range("FR4").Value = 1
End If

'Move Initial Setup page to the end and select A1 on Attendance Page
Sheets("Initial Setup").Select
Sheets("Initial Setup").Move After:=Sheets(5)
Sheets("Attendance").Select

Msg = MsgBox("Setup is complete.", vbOKOnly, "Setup")

End Sub

Attendance Sheet

Private Sub CommandButton1_Click()

Load UserForm1
UserForm1.Show (modal)

End Sub

Private Sub CommandButton2_Click()
Load LateArrivalsFrm
LateArrivalsFrm.Show

End Sub

Forms

New Day Form

Option Explicit
Dim CellName As String
Dim StudName As String
Dim Counter As Integer
Dim statevalue As String
Dim TodayDate
Dim TodayDay
Dim Msg

Private Sub NextButton_Click()

If presentoption.Value = True Then
statevalue = "P"
ElseIf lateoption.Value = True Then
statevalue = "L"
ElseIf absentoption.Value = True Then
statevalue = "A"
Else
Msg = MsgBox("You must Choose an option", vbOKOnly, "Error")
Exit Sub
End If

ActiveCell.Value = statevalue

ActiveCell.Offset(1, -Counter).Select

If ActiveCell = "" Then
Msg = MsgBox("You have completed the class list", vbOKOnly, "Completed")
UserForm1.Hide
Range("A1").Select

Exit Sub
End If

StudName = ActiveCell.Value

UserForm1.StudentName.Caption = StudName

ActiveCell.Offset(0, Counter).Select
UserForm1.presentoption = True

End Sub

Private Sub presentoption_Click()

End Sub

Private Sub UserForm_Activate()

'Check if there should be a class today
TodayDate = Date
TodayDay = Weekday(TodayDate)

Select Case TodayDay
Case 2
Range("B42").Select
If ActiveCell.Value = "" Then
Msg = MsgBox("You do not appear to have this class today.", vbOKOnly, "Error")
UserForm1.Hide
Exit Sub
End If
Case 3
Range("B43").Select
If ActiveCell.Value = "" Then
Msg = MsgBox("You do not appear to have this class today.", vbOKOnly, "Error")
UserForm1.Hide
Exit Sub
End If
Case 4
Range("B44").Select
If ActiveCell.Value = "" Then
Msg = MsgBox("You do not appear to have this class today.", vbOKOnly, "Error")
UserForm1.Hide
Exit Sub
End If
Case 5
Range("B45").Select
If ActiveCell.Value = "" Then
Msg = MsgBox("You do not appear to have this class today.", vbOKOnly, "Error")
UserForm1.Hide
Exit Sub
End If
Case 6
Range("B46").Select
If ActiveCell.Value = "" Then
Msg = MsgBox("You do not appear to have this class today.", vbOKOnly, "Error")
UserForm1.Hide
Exit Sub
End If
Case Else
Msg = MsgBox("You do not appear to have this class today.", vbOKOnly, "Error")
UserForm1.Hide
Exit Sub
End Select

Counter = 0
Range("A4").Select

Do Until Selection = ""
ActiveCell.Offset(0, 1).Select
Counter = Counter + 1
Loop

ActiveCell.Value = Date
CellName = ActiveCell.Address

UserForm1.DateLable.Caption = Date

Range("A5").Select
StudName = ActiveCell.Value

UserForm1.StudentName.Caption = StudName

ActiveCell.Offset(0, Counter).Select
UserForm1.presentoption.Value = True

UserForm1.NextButton.SetFocus

End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

Cancel = True

 

End Sub

Late Arrivals Form

Option Explicit
Dim StartTime
Dim CurrentTime
Dim TimeDifference
Dim CounterAccross
Dim StudentName
Dim CellName
Dim TodayDate
Dim TodayDay
Dim Msg

Private Sub CommandButton1_Click()

StudentName = ComboBox1.SelText
CounterAccross = 0
Range("A4").Select

Do Until Selection = ""
CounterAccross = CounterAccross + 1
ActiveCell.Offset(0, 1).Select
Loop

CounterAccross = CounterAccross - 1
Range("A4").Select

Do Until Selection = ""

If ActiveCell.Value = StudentName Then
CellName = ActiveCell.Address
Sheet5.Activate
Range(CellName).Select
ActiveCell.Offset(0, CounterAccross).Select
ActiveCell.Value = LateArrivalsFrm.Label6.Caption
CellName = ActiveCell.Address
Sheet1.Activate
Range(CellName).Select
ActiveCell.Value = "L"

End If


ActiveCell.Offset(1, 0).Select


Loop

End Sub

Private Sub CommandButton2_Click()
LateArrivalsFrm.Hide

End Sub

Private Sub UserForm_Activate()

'Check if there should be a class today
TodayDate = Date
TodayDay = Weekday(TodayDate)

Select Case TodayDay
Case 2
Range("B42").Select
If ActiveCell.Value = "" Then
Msg = MsgBox("You do not appear to have this class today.", vbOKOnly, "Error")
LateArrivalsFrm.Hide
Exit Sub
End If
Case 3
Range("B43").Select
If ActiveCell.Value = "" Then
Msg = MsgBox("You do not appear to have this class today.", vbOKOnly, "Error")
LateArrivalsFrm.Hide
Exit Sub
End If
Case 4
Range("B44").Select
If ActiveCell.Value = "" Then
Msg = MsgBox("You do not appear to have this class today.", vbOKOnly, "Error")
LateArrivalsFrm.Hide
Exit Sub
End If
Case 5
Range("B45").Select
If ActiveCell.Value = "" Then
Msg = MsgBox("You do not appear to have this class today.", vbOKOnly, "Error")
LateArrivalsFrm.Hide
Exit Sub
End If
Case 6
Range("B46").Select
If ActiveCell.Value = "" Then
Msg = MsgBox("You do not appear to have this class today.", vbOKOnly, "Error")
LateArrivalsFrm.Hide
Exit Sub
End If
Case Else
Msg = MsgBox("You do not appear to have this class today.", vbOKOnly, "Error")
LateArrivalsFrm.Hide
Exit Sub
End Select

' Set Time Differnece
CurrentTime = Time
CurrentTime = FormatDateTime(CurrentTime, vbShortTime)

StartTime = ActiveCell.Value
StartTime = FormatDateTime(StartTime, vbShortTime)
LateArrivalsFrm.Label3.Caption = StartTime
LateArrivalsFrm.Label4.Caption = CurrentTime
TimeDifference = DateDiff("n", StartTime, CurrentTime)
LateArrivalsFrm.Label6.Caption = TimeDifference

' Load Listbox with absent students
LateArrivalsFrm.ComboBox1.Clear
CounterAccross = 0
Range("A4").Select

Do Until Selection = ""
ActiveCell.Offset(0, 1).Select
CounterAccross = CounterAccross + 1
Loop

ActiveCell.Offset(1, -1).Select
CounterAccross = CounterAccross - 1

Do Until Selection = ""

If ActiveCell.Value = "A" Then
ActiveCell.Offset(0, -CounterAccross).Select
StudentName = ActiveCell.Value
LateArrivalsFrm.ComboBox1.AddItem StudentName
ActiveCell.Offset(0, CounterAccross).Select
End If

ActiveCell.Offset(1, 0).Select
Loop

End Sub

Student Report

Option Explicit
Dim StudentName
Dim WhichStudent
Dim ValueHolder
Dim RangeValueNumber
Dim RangeValue
Dim RangeValueTwo
Dim Msg
Dim CListCounter
Dim Counter
Dim RangeHolder
Dim SettingStudentSwitch
Dim ReportRangeHolder

Private Sub ComboBox1_Change()
If ComboBox1.Value = "Select A Student" Then
Exit Sub
End If
' Add Statistics
WhichStudent = ComboBox1.Value
RangeValueNumber = ComboBox1.ListIndex + 5
Range("C5").Value = WhichStudent
RangeValue = "FQ4"
ValueHolder = Sheet1.Range(RangeValue).Value
Range("C9").Value = ValueHolder
RangeValue = "FM" & RangeValueNumber
ValueHolder = Sheet1.Range(RangeValue).Value
Range("C10").Value = ValueHolder
RangeValue = "D" & RangeValueNumber
ValueHolder = Sheet4.Range(RangeValue).Value
Range("C11").Value = ValueHolder
RangeValue = "FN" & RangeValueNumber
ValueHolder = Sheet1.Range(RangeValue).Value
Range("C13").Value = ValueHolder
RangeValue = "E" & RangeValueNumber
RangeValueTwo = "F" & RangeValueNumber
ValueHolder = Sheet4.Range(RangeValue).Value & " hours " & Sheet4.Range(RangeValueTwo).Value & " mins"
Range("C14").Value = ValueHolder

' Add days Absent

' Determine students position on Attendance Sheet
Counter = 5
Sheet1.Select
Sheet1.Range("A5").Select
Do Until ActiveCell.Value = WhichStudent
ActiveCell.Offset(1, 0).Select
Counter = Counter + 1
Loop
RangeHolder = Counter - 4
ReportRangeHolder = "F6"
' Determine dates for Absent
Do Until ActiveCell.Value = ""
ActiveCell.Offset(0, 1).Select
If ActiveCell.Value = "A" Then
RangeValueTwo = ActiveCell.Address
ActiveCell.Offset(-RangeHolder, 0).Select
ValueHolder = ActiveCell.Value

Call PlaceDate
End If
Loop

Sheet2.Select

End Sub
Private Sub PlaceDate()
Sheet2.Select
Range(ReportRangeHolder).Select
ActiveCell.Value = ValueHolder
ActiveCell.Offset(1, 0).Select
ReportRangeHolder = ActiveCell.Address
Sheet1.Select
Sheet1.Range(RangeValueTwo).Select

End Sub

Private Sub CommandButton1_Click()
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End Sub

Private Sub CommandButton2_Click()

Msg = MsgBox("Are you sure you want to print ALL reports ?", vbYesNo, "Print All Reports")
If Msg = vbYes Then
CListCounter = 0
Do While CListCounter < ComboBox1.ListCount
ComboBox1.ListIndex = CListCounter
Call ComboBox1_Change
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
CListCounter = CListCounter + 1
Loop

Else
Exit Sub
End If
End Sub

Private Sub Worksheet_Activate()
'If SettingStudentSwitch = 1 Then
'Exit Sub
'End If
If ComboBox1.ListCount > 1 Then
Exit Sub
End If
ComboBox1.Clear
Counter = 5
Do While Counter < 35
RangeHolder = "A" & Counter
ValueHolder = Sheet1.Range(RangeHolder).Value
If ValueHolder <> "" Then
Sheet2.ComboBox1.AddItem ValueHolder
End If
Counter = Counter + 1
Loop
Sheet2.ComboBox1.Text = "Select A Student"
'SettingStudentSwitch = 1
End Sub