.Cells(Row + 1, 1).Value = "Студент"
.Cells(Row + 1, 2).Value = StudentVal
Range(.Cells(Row + 1, 2), .Cells(Row + 1, 3)).MergeCells = True
Range(.Cells(Row, 2), .Cells(Row + 1, 2)).Select
With Selection.Interior
.ColorIndex = 36
.Pattern = xlSolid
End With
.Cells(Row + 2, 1).Value = "Оценки по предметам"
.Cells(Row + 2, 2).Value = "1-ый семестр"
.Cells(Row + 2, 3).Value = "2-ой семестр"
Range(.Cells(Row + 2, 2), .Cells(Row + 2, 3)).Select
With Selection
.HorizontalAlignment = xlCenter
.Interior.ColorIndex = 37
.Interior.Pattern = xlSolid
End With
For k = 0 To 8
.Cells(Row + 3 + k, 1).Value = Worksheets("Storage").Cells(1, k + 5).Value
.Cells(Row + 3 + k, 2).Value = Split(Worksheets("Storage").Cells(j, k + 5).Value, ":")(0)
.Cells(Row + 3 + k, 3).Value = Split(Worksheets("Storage").Cells(j, k + 5).Value, ":")(1)
Next k
Range(.Cells(Row + 3, 2), .Cells(Row + 2 + k, 3)).Select
With Selection
.HorizontalAlignment = xlCenter
.Interior.ColorIndex = 35
.Interior.Pattern = xlSolid
End With
Range(.Cells(Row, 1), .Cells(Row + 2 + k, 1)).Select
With Selection.Interior
.ColorIndex = 40
.Pattern = xlSolid
End With
Range(.Cells(Row, 1), .Cells(Row + 2 + k, 3)).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Row = Row + k + 5
End If
End If
j = j + 1
Loop Until Len(Value) = 0
Next i
End With
End Sub
Private Sub Down_Click()
Dim Index As Integer
Dim Value As String
Index = Queue.ListIndex
If Index <> Queue.ListCount - 1 And Index <> - 1 Then
Value = Queue.Value
Queue.RemoveItem (Index)
Queue.AddItem Value, Index + 1
Queue.ListIndex = Index + 1
End If
End Sub
Private Sub Group_Change()
Dim i As Integer
Dim Value As String
i = 2
Student.Clear
With ActiveWorkbook.Sheets(1)
Do
Value = .Cells(i, 1).Value
If Value = Group.Value Then
Student.AddItem .Cells(i, 2).Value + " " + .Cells(i, 3).Value + " " + .Cells(i, 4).Value
End If
i = i + 1
Loop Until Len(Value) = 0
End With
Student.ListIndex = 0
End Sub
Private Sub Remove_Click()
If Not (Queue.ListCount = 0 Or Queue.ListIndex = - 1) Then
Queue.RemoveItem Queue.ListIndex
End If
End Sub
Private Sub Up_Click()
Dim Index As Integer
Dim Value As String
Index = Queue.ListIndex
If Index > 0 Then
Value = Queue.Value
Queue.RemoveItem Index
Queue.AddItem Value, Index - 1
Queue.ListIndex = Index - 1
End If
End Sub
Private Sub UserForm_Initialize()
Dim i As Integer
Dim Value As String
i = 2
With ActiveWorkbook.Sheets(1)
Do
Value = .Cells(i, 1).Value
If Len(Value) > 0 Then
For j = 0 To Group.ListCount - 1
If Group.List(j) = Value Then Exit For
Next j
If j = Group.ListCount Then Group.AddItem Value
i = i + 1
End If
Loop Until Len(Value) = 0
End With
Group.ListIndex = 0
End Sub
Форма «DataForm»:
Dim Cursor As Integer
Dim Count As Integer
Dim ObjectList() As Integer
Private Sub AutumnCtrl_Change()
Autumn.Value = AutumnCtrl.Value
ObjectList(Objects.ListIndex, 0) = Autumn.Value
End Sub
Private Sub Backward_Click()
If Cursor - 1 >= 0 Then
Cursor = Cursor - 1
LoadObject (Cursor)
End If
End Sub
Private Sub Begin_Click()
Cursor = 0
LoadObject (Cursor)
End Sub
Private Sub Cancel_Click()
Me.Hide
End Sub
Private Sub Delete_Click()
If Cursor <> Count Then
ActiveWorkbook.Sheets("Storage").Rows(Cursor + 2).Delete Shift:=xlUp
If Cursor = Count - 1 Then Cursor = Cursor - 1
Count = Count - 1
LoadObject (Cursor)
End If
End Sub
Private Sub Forward_Click()
If Cursor + 1 <= Count Then
If Cursor + 1 = Count Then
NewItem_Click
Exit Sub
End If
Cursor = Cursor + 1
LoadObject (Cursor)
End If
End Sub
Private Sub NewItem_Click()
Cursor = Count
ClearObject
ItemCount.Caption = "Новый элемент"
End Sub
Private Sub Objects_Change()
Autumn.Value = ObjectList(Objects.ListIndex, 0)
Spring.Value = ObjectList(Objects.ListIndex, 1)
AutumnCtrl.Value = Autumn.Value
SpringCtrl.Value = Spring.Value
End Sub
Private Sub SpringCtrl_Change()
Spring.Value = SpringCtrl.Value
ObjectList(Objects.ListIndex, 1) = Spring.Value
End Sub
Private Sub Update_Click()
With ActiveWorkbook.Sheets("Storage")
If (Len(Group.Value) = 0) Then
MsgBox "Необходимо ввести номер группы!"
Exit Sub
End If
If (Len(Last.Value) = 0) Then
MsgBox "Необходимо ввести фамилию студента!"
Exit Sub
End If
If (Len(First.Value) = 0) Then
MsgBox "Необходимо ввести имя студента!"
Exit Sub
End If
If (Len(Middle.Value) = 0) Then
MsgBox "Необходимо ввести отчество студента!"
Exit Sub
End If
.Cells(Cursor + 2, 1) = Group.Value
.Cells(Cursor + 2, 2) = Last.Value
.Cells(Cursor + 2, 3) = First.Value
.Cells(Cursor + 2, 4) = Middle.Value
For i = 0 To Objects.ListCount - 1
.Cells(Cursor + 2, i + 5) = Trim(Str(ObjectList(i, 0))) + ":" + Trim(Str(ObjectList(i, 1)))
Next i
End With
If Cursor = Count Then
Count = Count + 1
ItemCount.Caption = "Элемент " + Str(Cursor + 1) + " из " + Str(Count)
End If
End Sub
Private Sub UserForm_Initialize()
Dim i As Integer
Dim Value As String
Cursor = 0
i = 5
Count = GetListCount()
With ActiveWorkbook.Sheets("Storage")
Do
Value = .Cells(1, i).Value
If Len(Value) > 0 Then
For j = 0 To Objects.ListCount - 1
If Objects.List(j) = Value Then Exit For
Next j
If j = Objects.ListCount Then Objects.AddItem Value
i = i + 1
End If
Loop Until Len(Value) = 0
End With
ReDim ObjectList(Objects.ListCount - 1, 1)
LoadObject (Cursor)
End Sub
Private Sub LoadObject(Index As Integer)
With ActiveWorkbook.Sheets("Storage")
Group.Value = .Cells(Cursor + 2, 1)
Last.Value = .Cells(Cursor + 2, 2)
First.Value = .Cells(Cursor + 2, 3)
Middle.Value = .Cells(Cursor + 2, 4)
For i = 0 To Objects.ListCount - 1
ObjectList(i, 0) = Split(.Cells(Cursor + 2, i + 5), ":")(0)
ObjectList(i, 1) = Split(.Cells(Cursor + 2, i + 5), ":")(1)
Next i
If Objects.ListIndex = 0 Then Call Objects_Change
Objects.ListIndex = 0
ItemCount.Caption = "Элемент " + Str(Cursor + 1) + " из " + Str(Count)
End With
End Sub
Private Function GetListCount() As Integer
Dim i As Integer
GetListCount = 0
While Len(ThisWorkbook.Sheets("Storage").Cells(GetListCount + 2, 1).Value) <> 0
GetListCount = GetListCount + 1
Wend
End Function
Private Sub ClearObject()
Group.Value = ""
First.Value = ""
Last.Value = ""
Middle.Value = ""
For i = 0 To Objects.ListCount - 1
ObjectList(i, 0) = 2
ObjectList(i, 1) = 2
Next i
Autumn.Value = ""
Spring.Value = ""
Call Objects_Change
End Sub
Форма «DiaGroupForm»:
Private Sub Autumn_Click()
Autumn.Value = True
Spring.Value = False
End Sub
Private Sub Cancel_Click()
Me.Hide
End Sub
Private Sub Create_Click()
Dim j As Integer
Dim Stat(3) As Integer
Dim Index As Integer
Dim Count As Integer
Dim ChartObj As ChartObject
j = 2
Index = 0
For i = 0 To 3
Stat(i) = 0
Next i
If Autumn.Value = True Then Index = 0 Else Index = 1
ActiveWorkbook.Worksheets.Add After:=Worksheets(Worksheets.Count)
With ActiveSheet
.Cells.Clear
Do
Value = Worksheets("Storage").Cells(j, 1).Value
If Len(Value) > 0 Then
If Worksheets("Storage").Cells(j, 1).Value = Group.Value Then
If Split(Worksheets("Storage").Cells(j, Object.ListIndex + 5).Value, ":")(Index) = "5" Then Stat(0) = Stat(0) + 1
If Split(Worksheets("Storage").Cells(j, Object.ListIndex + 5).Value, ":")(Index) = "4" Then Stat(1) = Stat(1) + 1
If Split(Worksheets("Storage").Cells(j, Object.ListIndex + 5).Value, ":")(Index) = "3" Then Stat(2) = Stat(2) + 1
If Split(Worksheets("Storage").Cells(j, Object.ListIndex + 5).Value, ":")(Index) = "2" Then Stat(3) = Stat(3) + 1
End If
End If
j = j + 1
Loop Until Len(Value) = 0
.Cells(1, 1).Value = "Диаграмма успеваемости группы " + Group.Value
.Cells(2, 1).Value = "по предмету " + Object.Value
.Cells(3, 1).Value = "за " + Str(Index + 1) + "-й семестр"
For i = 0 To 3
.Cells(i + 4, 1).Value = "Оценка " + Str(5 - i)
.Cells(i + 4, 2).Value = Str(Stat(i))
Next i
Set ChartObj = .ChartObjects.Add(0, 0, 400, 400)
ChartObj.Chart.ChartType = xlPie
ChartObj.Chart.SeriesCollection.Add Source:=Range(.Cells(4, 2), .Cells(7, 2))
ChartObj.Chart.SeriesCollection.Item(1).XValues = Range(.Cells(4, 1), .Cells(7, 1))
ChartObj.Chart.HasLegend = True
ChartObj.Chart.Legend.Position = xlBottom
ChartObj.Chart.HasTitle = True
ChartObj.Chart.ChartTitle.Text = "Диаграмма успеваемости группы " + Group.Value + Chr(10) + "по предмету " + Object.Value + Chr(10) + "за " + Str(Index + 1) + "-й семестр"
End With
End Sub
Private Sub Spring_Click()
Spring.Value = True
Autumn.Value = False
End Sub
Private Sub UserForm_Initialize()
Dim i As Integer
Dim Value As String
i = 2
With ActiveWorkbook.Sheets(1)
Do
Value = .Cells(i, 1).Value
If Len(Value) > 0 Then
For j = 0 To Group.ListCount - 1
If Group.List(j) = Value Then Exit For
Next j
If j = Group.ListCount Then Group.AddItem Value
i = i + 1
End If
Loop Until Len(Value) = 0
End With
Group.ListIndex = 0
For j = 0 To 8
Object.AddItem ActiveWorkbook.Sheets("Storage").Cells(1, j + 5).Value
Next j
Object.ListIndex = 0
Autumn.Value = True
End Sub
Форма «DiaStudentForm»:
Private Sub Autumn_Click()
Autumn.Value = True
Spring.Value = False
End Sub
Private Sub Cancel_Click()
Me.Hide
End Sub
Private Sub Create_Click()
Dim j As Integer
Dim Stat(3) As Integer
Dim Index As Integer
Dim Count As Integer
Dim ChartObj As ChartObject
j = 2
Index = 0
For i = 0 To 3
Stat(i) = 0
Next i
If Autumn.Value = True Then Index = 0 Else Index = 1
ActiveWorkbook.Worksheets.Add After:=Worksheets(Worksheets.Count)
With ActiveSheet
.Cells.Clear
Do
Value = Worksheets("Storage").Cells(j, 1).Value
If Len(Value) > 0 Then
If Worksheets("Storage").Cells(j, 2).Value + " " + Worksheets("Storage").Cells(j, 3).Value + " " + Worksheets("Storage").Cells(j, 4).Value = Student.Value Then Exit Do
End If
j = j + 1
Loop Until Len(Value) = 0
For i = 0 To 8
If Split(Worksheets("Storage").Cells(j, i + 5).Value, ":")(Index) = "5" Then Stat(0) = Stat(0) + 1
If Split(Worksheets("Storage").Cells(j, i + 5).Value, ":")(Index) = "4" Then Stat(1) = Stat(1) + 1
If Split(Worksheets("Storage").Cells(j, i + 5).Value, ":")(Index) = "3" Then Stat(2) = Stat(2) + 1
If Split(Worksheets("Storage").Cells(j, i + 5).Value, ":")(Index) = "2" Then Stat(3) = Stat(3) + 1
Next i
.Cells(1, 1).Value = "Диаграмма успеваемости студента: "
.Cells(2, 1).Value = Student.Value
.Cells(3, 1).Value = Str(Index + 1) + "-й семестр"
For i = 0 To 3
.Cells(i + 4, 1).Value = "Оценка " + Str(5 - i)
.Cells(i + 4, 2).Value = Str(Stat(i))
Next i
Set ChartObj = .ChartObjects.Add(0, 0, 400, 400)
ChartObj.Chart.ChartType = xlPie
ChartObj.Chart.SeriesCollection.Add Source:=Range(.Cells(4, 2), .Cells(7, 2))
ChartObj.Chart.SeriesCollection.Item(1).XValues = Range(.Cells(4, 1), .Cells(7, 1))
ChartObj.Chart.HasLegend = True
ChartObj.Chart.Legend.Position = xlBottom
ChartObj.Chart.HasTitle = True
ChartObj.Chart.ChartTitle.Text = "Диаграмма успеваемости студента" + Chr(10) + Student.Value + Chr(10) + Str(Index + 1) + "-й семестр"
End With
End Sub
Private Sub Group_Change()
Dim i As Integer
Dim Value As String
i = 2
Student.Clear
With ActiveWorkbook.Sheets("Storage")
Do
Value = .Cells(i, 1).Value
If Value = Group.Value Then
Student.AddItem .Cells(i, 2).Value + " " + .Cells(i, 3).Value + " " + .Cells(i, 4).Value
End If
i = i + 1
Loop Until Len(Value) = 0
End With
Student.ListIndex = 0
End Sub
Private Sub Spring_Click()
Spring.Value = True
Autumn.Value = False
End Sub
Private Sub UserForm_Initialize()
Dim i As Integer
Dim Value As String
i = 2
With ActiveWorkbook.Sheets("Storage")
Do
Value = .Cells(i, 1).Value
If Len(Value) > 0 Then
For j = 0 To Group.ListCount - 1
If Group.List(j) = Value Then Exit For
Next j
If j = Group.ListCount Then Group.AddItem Value
i = i + 1
End If
Loop Until Len(Value) = 0
End With
Group.ListIndex = 0
Autumn.Value = True
End Sub
Модули:
Модуль Main:
Public Sub QDialog1()
MainForm.Show
End Sub
Модуль Module 1:
Sub Macro1()
'' Macro1 Macro
' Macro recorded 25.12.2006 by Zeon
'Columns("A:A").ColumnWidth = 33.29
Columns("B:B").ColumnWidth = 17.14
Columns("C:C").ColumnWidth = 16.57
End Sub
Модуль Module 2:
Sub Macro2()
'' Macro2 Macro
' Macro recorded 25.12.2006 by Zeon
'Range("C17:D17").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
Range("C16:D16").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
Range("C19:D27").Select