Листинг программы
Microsoft Excel Objects
ЭтаКнига
Private Sub Workbook_Open()
Dim ItButton As CommandBarButton
Dim MyBar As CommandBar
Set MyBar = Application.CommandBars.Add
With MyBar
.Name = "Панель Итоги"
.Visible = True
.Position = msoBarTop
End With
Set ItButton = MyBar.Controls.Add(Type:=msoControlButton)
With ItButton
.Style = msoButtonCaption
.Caption = "Текущие итоги"
.Enabled = True
.OnAction = "ВызовФормы"
End With
With MyBar.Controls.Add(Type:=msoControlButton)
.Style = msoButtonCaption
.Caption = "О программе"
.Enabled = True
.OnAction = "ЭтаКнига.Информация"
End With
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
For Each Bar In Application.CommandBars
If Bar.Name = "Панель Итоги" Then
Bar.Delete
Exit For
End If
Next
End Sub
Sub Информация()
MsgBox ("Разработчик программы:" & Chr(13) & "Студентка группы МИТ-14-2" & Chr(13) & "Института ИТАСУ" & Chr(13) & "Николаева Галина Леонидовна"), vbOKOnly + vbInformation, "О программе"
End Sub
Forms
FrmИтоги
Option Base 1
Public Имя As String
Private Sub UserForm_Initialize()
Dim ГранПри(5) As String
ГранПри(1) = "1-Австралия"
ГранПри(2) = "2-Бразилия"
ГранПри(3) = "3-Китай"
ГранПри(4) = "4-Испания"
ГранПри(5) = "5-Канада"
frmИтоги.cboВыбранныйГранПри.List = ГранПри
frmИтоги.optЛичныйЗачет.Value = True
End Sub
Private Sub cmdOK_Click()
Dim ГранПри As String
Dim КолУчастников As Integer
Dim Path(5) As String
ГранПри = cboВыбранныйГранПри.Value
НомерГонки = Val(cboВыбранныйГранПри.Value)
ВыбраннаяСтрана = Mid(ГранПри, 3)
If ГранПри = "" Then
Unload Me
MsgBox "Не выбрана ни одна из гонок!", vbCritical
End
End If
Call СуществованиеГранПри(НомерГонки, ВыбраннаяСтрана)
Path(1) = "C:\Результаты\Гран-При-1-Австралия.xls"
Path(2) = "C:\Результаты\Гран-При-2-Бразилия.xls"
Path(3) = "C:\Результаты\Гран-При-3-Китай.xls"
Path(4) = "C:\Результаты\Гран-При-4-Испания.xls"
Path(5) = "C:\Результаты\Гран-При-5-Канада.xls"
Unload Me
Call СуществованиеПапки
НачалоСтраны = 4
If optЛичныйЗачет.Value = True Then
Имя = "Личный зачет"
Call СуществованиеФайлаПилоты
Call ВыводЛичныйЗачет(НомерГонки, ВыбраннаяСтрана)
Call ШапкаЗачет
Else
Имя = "Кубок конструкторов"
Call СуществованиеФайлаКоманды
Call ВыводКубок(НомерГонки, ВыбраннаяСтрана)
Call ШапкаКубок
End If
Range("A1").Select
ActiveWorkbook.Save
MsgBox "Операция завершена!", vbInformation
End Sub
Sub cmdОтмена_Click()
Unload Me
End Sub
Modules
Module1
Sub ВызовФормы()
frmИтоги.Show
End Sub
Вывод
Option Base 1
Public flag As Integer
Sub ВыводЛичныйЗачет(НомерГонки, ВыбраннаяСтрана)
Dim Пилоты(), Path(5), Путь(5), П(5) As String
Dim КолУчастников, НомерСтроки As Integer
НомерСтроки = 3
НомерСтр = 3
НачалоСтраны = 4
Path(1) = "Гран-При-1-Австралия.xls"
Path(2) = "Гран-При-2-Бразилия.xls"
Path(3) = "Гран-При-3-Китай.xls"
Path(4) = "Гран-При-4-Испания.xls"
Path(5) = "Гран-При-5-Канада.xls"
Путь(1) = "Гран-При-1-Австралия"
Путь(2) = "Гран-При-2-Бразилия"
Путь(3) = "Гран-При-3-Китай"
Путь(4) = "Гран-При-4-Испания"
Путь(5) = "Гран-При-5-Канада"
For z = 1 To НомерГонки
If z = Q(z) Then GoTo a1
Workbooks(Path(z)).Activate
КолУчастников = 0
НомерСтр = 3
НомерСтроки = 3
Страна = Mid(Путь(z), 12)
While Trim(Cells(НомерСтр, 1).Value) <> ""
КолУчастников = КолУчастников + 1
НомерСтр = НомерСтр + 1
Wend
Range(Cells(НомерСтроки, 1), Cells(НомерСтроки +_ КолУчастников - 1, 6)).Select
Selection.Sort Key1:=Cells(НомерСтроки, 6),_ Order1:=xlDescending, Header:=xlGuess
For i = 1 To 3
ReDim Preserve Пилоты(4, i)
Пилоты(1, i) = i
Пилоты(2, i) = Cells(НомерСтроки, 3).Value
Пилоты(3, i) = Cells(НомерСтроки, 4).Value
Пилоты(4, i) = Cells(НомерСтроки, 6).Value
НомерСтроки = НомерСтроки + 1
Next i
Workbooks("Пилоты-призёры.xls").Activate
For k = 1 To 3
Cells(k + НачалоСтраны - 1, 1).Value = Пилоты(1, k)
Cells(k + НачалоСтраны - 1, 2).Value = Пилоты(2, k)
Cells(k + НачалоСтраны - 1, 3).Value = Пилоты(3, k)
Cells(k + НачалоСтраны - 1, 4).Value = Пилоты(4, k)
Next k
Call ОформлениеПилоты(НачалоСтраны, z, Страна)
НачалоСтраны = НачалоСтраны + 5
While Trim(Cells(НачалоСтраны, 1).Value) <> ""
НачалоСтраны = НачалоСтраны + 1
Wend
a1: Next z
End Sub
Sub ВыводКубок(НомерГонки, ВыбраннаяСтрана)
Dim Path(5), Команды(), temp(), Путь(5) As String
Dim КолУчастников, НомерСтроки As Integer
НомерСтроки = 3
НомерСтр = 3
НачалоСтраны = 4
Строка = 3
Path(1) = "Гран-При-1-Австралия.xls"
Path(2) = "Гран-При-2-Бразилия.xls"
Path(3) = "Гран-При-3-Китай.xls"
Path(4) = "Гран-При-4-Испания.xls"
Path(5) = "Гран-При-5-Канада.xls"
Путь(1) = "Гран-При-1-Австралия"
Путь(2) = "Гран-При-2-Бразилия"
Путь(3) = "Гран-При-3-Китай"
Путь(4) = "Гран-При-4-Испания"
Путь(5) = "Гран-При-5-Канада"
For z = 1 To НомерГонки
If z = Q(z) Then GoTo a1
Workbooks(Path(z)).Activate
КолУчастников = 0
НомерСтр = 3
НомерСтроки = 3
Строка = 3
Страна = Mid(Путь(z), 12)
While Trim(Cells(НомерСтр, 1).Value) <> ""
КолУчастников = КолУчастников + 1
НомерСтр = НомерСтр + 1
Wend
Range(Cells(НомерСтроки, 1), Cells(НомерСтроки +_ КолУчастников - 1, 6)).Select
Selection.Sort Key1:=Cells(НомерСтроки, 4),_ Order1:=xlDescending, Header:=xlGuess, Key2:=Cells(НомерСтроки, 6), Order1:=xlAscending,_ Header:=xlGuess
For i = 1 To КолУчастников / 2
ReDim Preserve Команды(3, i)
Команды(1, i) = i
Команды(2, i) = Cells(Строка, 4).Value
Команды(3, i) = Cells(Строка, 6).Value + Cells(Строка_ + 1, 6).Value
Строка = Строка + 2
Next i
ReDim temp(3, КолУчастников / 2)
For j = 1 To КолУчастников / 2
For i = 1 To КолУчастников / 2
If Val(Команды(3, j)) > Val(Команды(3, i)) Then
temp(1, i) = j
temp(2, i) = Команды(2, i)
temp(3, i) = Команды(3, i)
Команды(1, i) = i
Команды(2, i) = Команды(2, j)
Команды(3, i) = Команды(3, j)
Команды(1, j) = temp(1, i)
Команды(2, j) = temp(2, i)
Команды(3, j) = temp(3, i)
End If
Next i
Next j
Workbooks("Команды-призёры.xls").Activate
For k = 1 To 3
Cells(k + НачалоСтраны - 1, 1).Value = Команды(1, k)
Cells(k + НачалоСтраны - 1, 2).Value = Команды(2, k)
Cells(k + НачалоСтраны - 1, 3).Value = Команды(3, k)
Next k
Call ОформлениеКоманды(НачалоСтраны, z, Страна)
НачалоСтраны = НачалоСтраны + 5
While Trim(Cells(НачалоСтраны, 1).Value) <> ""
НачалоСтраны = НачалоСтраны + 1
Wend
a1: Next z
End Sub
Sub ОформлениеПилоты(НачалоСтраны, z, Страна)
Range(Cells(НачалоСтраны - 2, 1), Cells(НачалоСтраны - 2,_ 4)).Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
End With
Selection.Merge
With Selection.Font
.Name = "Times New Roman"
.Size = 12
End With
ActiveCell.FormulaR1C1 = "Гран-При-" & z & "-" & Страна
Selection.Font.Bold = True
Range(Cells(НачалоСтраны - 1, 1), Cells(НачалоСтраны - 1,_ 4)).Select
Selection.Font.Bold = True
With Selection.Font
.Name = "Times New Roman"
.Size = 11
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
End With
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
End With
Cells(НачалоСтраны - 1, 1).Select
ActiveCell.FormulaR1C1 = "Поз"
Cells(НачалоСтраны - 1, 2).Select
ActiveCell.FormulaR1C1 = "Пилот"
Cells(НачалоСтраны - 1, 3).Select
ActiveCell.FormulaR1C1 = "Команда"
Cells(НачалоСтраны - 1, 4).Select
ActiveCell.FormulaR1C1 = "Очки"
Range(Cells(НачалоСтраны, 1), Cells(НачалоСтраны + 2, 4)).Select
With Selection.Font
.Name = "Times New Roman"
.Size = 11
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 1
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 1
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 1
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 1
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 1
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 1
End With
Columns("A:A").ColumnWidth = 10
Columns("B:B").ColumnWidth = 25
Columns("C:C").ColumnWidth = 25
Columns("D:D").ColumnWidth = 11
End Sub
Sub ОформлениеКоманды(НачалоСтраны, z, Страна)
Range(Cells(НачалоСтраны - 2, 1), Cells(НачалоСтраны - 2,_ 3)).Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
End With
Selection.Merge
With Selection.Font
.Name = "Times New Roman"
.Size = 12
End With
ActiveCell.FormulaR1C1 = "Гран-При-" & z & "-" & Страна
Selection.Font.Bold = True
Range(Cells(НачалоСтраны - 1, 1), Cells(НачалоСтраны - 1,_ 3)).Select
Selection.Font.Bold = True
With Selection.Font
.Name = "Times New Roman"
.Size = 11
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
End With
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
End With
Cells(НачалоСтраны - 1, 1).Select
ActiveCell.FormulaR1C1 = "Поз"
Cells(НачалоСтраны - 1, 2).Select
ActiveCell.FormulaR1C1 = "Команда"
Cells(НачалоСтраны - 1, 3).Select
ActiveCell.FormulaR1C1 = "Очки"
Range(Cells(НачалоСтраны, 1), Cells(НачалоСтраны + 2, 3)).Select
With Selection.Font
.Name = "Times New Roman"
.Size = 11
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 1
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 1
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 1
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 1
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 1
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 1
End With
Columns("A:A").ColumnWidth = 10
Columns("B:B").ColumnWidth = 25
Columns("C:C").ColumnWidth = 25
End Sub
Sub ШапкаЗачет()
Range("A1:D1").Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
End With
Selection.Merge
With Selection.Font
.Name = "Times New Roman"
.Size = 12
End With
ActiveCell.FormulaR1C1 = "Личный зачет"
Selection.Font.Bold = True
End Sub
Sub ШапкаКубок()
Range("A1:C1").Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
End With
Selection.Merge
With Selection.Font
.Name = "Times New Roman"
.Size = 12
End With
ActiveCell.FormulaR1C1 = "Кубок конструкторов"
Selection.Font.Bold = True
End Sub