2. Листинг программы

   1. Microsoft Excel Objects

      1. ЭтаКнига

Private Sub Workbook_Open()

Dim MyBar As CommandBar

Set MyBar = Application.CommandBars.Add

With MyBar

.Visible = True

.Position = msoBarTop

.Name = "Соревнования"

End With

With MyBar.Controls.Add(Type:=msoControlButton)

.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

2. Forms

   1. FrmВыбора

Option Base 1

Sub UserForm_Initialize()

cmdОК.Default = True

cmdОтмена.Cancel = True

Dim Стили() As String

Dim Стиль As String

Dim НомерСтроки As Integer

Dim КолСтилей, k, i, j As Integer

Call СуществованиеФайла

Call СуществованиеЛиста

ReDim Preserve Стили(1) As String

Стили(1) = Trim(Cells(2, 3).Value)

КолСтилей = 1

НомерСтроки = 2

While Trim(Cells(НомерСтроки, 1).Value) <> ""

Стиль = Trim(Cells(НомерСтроки, 3).Value)

For j = 1 To КолСтилей

If Стиль = Стили(j) Then GoTo n3

Next j

КолСтилей = КолСтилей + 1

ReDim Preserve Стили(КолСтилей) As String

Стили(КолСтилей) = Trim(Cells(НомерСтроки, 3).Value)

n3: НомерСтроки = НомерСтроки + 1

Wend

For i = 1 To КолСтилей - 1

Стиль = Стили(i)

k = i

For j = i + 1 To КолСтилей

If Стили(j) >= Стиль Then

Else

Стиль = Стили(j)

Стили(j) = Стили(k)

Стили(k) = Стиль

End If

Next

Next i

frmВыбора.CboСтиль.List = Стили

frmВыбора.CboСтиль.Value = Стили(1)

frmВыбора.optДевушки.Value = True

End Sub

Sub cmdОК_Click()

Dim Стиль, Пол, Имя As String

Dim КолУчастников As Integer

Стиль = CboСтиль.Value

If optДевушки.Value = True Then

Пол = "Ж"

Имя = "Девушки"

Else

Пол = "М"

Имя = "Юноши"

End If

Unload Me

Call СохранениеНовогоФайла(Стиль, Имя, Пол)

Call ВыводДанных(Стиль, Пол, Имя)

MsgBox "Операция завершена!", vbInformation

End Sub

Sub cmdОтмена_Click()

Unload Me

End Sub

3. Modules

   1. Module1

Sub ВызовФормы()

frmВыбора.Show

End Sub

2. Вывод

Public Имя, Стиль, Пол As String

Public flag, КолУчастников As Integer

Sub ВыводДанных(Стиль, Пол, Имя)

Dim НомерСтроки, flag, i, j As Integer

Dim КолСтилей As Integer

Dim Участники(), temp() As String

НовоеИмя = LCase(Имя)

КолУчастников = 0

НомерСтроки = 2

Workbooks("Участники соревнований.xls").Activate

While Cells(НомерСтроки, 1).Value <> ""

If Cells(НомерСтроки, 3).Value = Стиль And Cells(НомерСтроки, 6).Value = Пол Then

КолУчастников = КолУчастников + 1

ReDim Preserve Участники(7, КолУчастников)

Участники(1, КолУчастников) = КолУчастников

Участники(2, КолУчастников) = _

Cells(НомерСтроки, 2).Value

Участники(3, КолУчастников) = _

Cells(НомерСтроки, 1).Value

Участники(4, КолУчастников) = _

Cells(НомерСтроки, 4).Value

Участники(5, КолУчастников) = _

Cells(НомерСтроки, 5).Value

Участники(6, КолУчастников) = _

Cells(НомерСтроки, 7).Value

Участники(7, КолУчастников) = _

Cells(НомерСтроки, 8).Value

End If

НомерСтроки = НомерСтроки + 1

Wend

ReDim temp(7, КолУчастников)

For j = 1 To КолУчастников

For i = 1 To КолУчастников

If Val(Участники(4, j)) < Val(Участники(4, i)) Then

temp(1, i) = j

temp(2, i) = Участники(2, i)

temp(3, i) = Участники(3, i)

temp(4, i) = Участники(4, i)

temp(5, i) = Участники(5, i)

temp(6, i) = Участники(6, i)

temp(7, i) = Участники(7, i)

Участники(1, i) = i

Участники(2, i) = Участники(2, j)

Участники(3, i) = Участники(3, j)

Участники(4, i) = Участники(4, j)

Участники(5, i) = Участники(5, j)

Участники(6, i) = Участники(6, j)

Участники(7, i) = Участники(7, j)

Участники(1, j) = temp(1, i)

Участники(2, j) = temp(2, i)

Участники(3, j) = temp(3, i)

Участники(4, j) = temp(4, i)

Участники(5, j) = temp(5, i)

Участники(6, j) = temp(6, i)

Участники(7, j) = temp(7, i)

ElseIf Val(Участники(4, j)) = _

Val(Участники(4, i)) Then

If CDbl(Участники(7, j)) < _

CDbl(Участники(7, i)) Then

temp(1, i) = j

temp(2, i) = Участники(2, i)

temp(3, i) = Участники(3, i)

temp(4, i) = Участники(4, i)

temp(5, i) = Участники(5, i)

temp(6, i) = Участники(6, i)

temp(7, i) = Участники(7, i)

Участники(1, i) = i

Участники(2, i) = Участники(2, j)

Участники(3, i) = Участники(3, j)

Участники(4, i) = Участники(4, j)

Участники(5, i) = Участники(5, j)

Участники(6, i) = Участники(6, j)

Участники(7, i) = Участники(7, j)

Участники(1, j) = temp(1, i)

Участники(2, j) = temp(2, i)

Участники(3, j) = temp(3, i)

Участники(4, j) = temp(4, i)

Участники(5, j) = temp(5, i)

Участники(6, j) = temp(6, i)

Участники(7, j) = temp(7, i)

End If

End If

Next i

Next j

Workbooks(Стиль & "-" & НовоеИмя & ".xls").Activate

For i = 1 To КолУчастников

Cells(i + 2, 1).Value = Участники(1, i)

Cells(i + 2, 2).Value = Участники(2, i)

Cells(i + 2, 3).Value = Участники(3, i)

Cells(i + 2, 4).Value = Участники(4, i)

Cells(i + 2, 5).Value = Участники(5, i)

Cells(i + 2, 6).Value = Участники(6, i)

Cells(i + 2, 7).Value = CDbl(Участники(7, i))

Next i

ActiveWorkbook.Author = "Квасова В.О."

Range("A1").FormulaR1C1 = Стиль

Range("B1").FormulaR1C1 = Имя

Range("A2").FormulaR1C1 = "№ п.п."

Range("B2").FormulaR1C1 = "Участник соревнования"

Range("C2").FormulaR1C1 = "Спортивный клуб"

Range("D2").FormulaR1C1 = "Дистанция"

Range("E2").FormulaR1C1 = "Год рождения"

Range("F2").FormulaR1C1 = "Разряд"

Range("G2").FormulaR1C1 = "Результат"

Range("A1,B1").Select

With Selection.Font

.Name = "Arial Cyr"

.Size = 12

.Italic = True

.Bold = True

End With

With Selection

.HorizontalAlignment = xlCenter

.VerticalAlignment = xlBottom

End With

Range("A2:G2").Select

With Selection.Font

.Name = "Calibri"

.Size = 11

Italic = False

.Bold = True

End With

With Selection

.HorizontalAlignment = xlCenter

.VerticalAlignment = xlBottom

End With

Range(Cells(3, 1), Cells(КолУчастников + 2, 7)).Select

With Selection.Font

.Name = "Calibri"

.Size = 12

.Bold = True

End With

Range(Cells(2, 1), Cells(КолУчастников + 2, 7)).Select

With Selection

.HorizontalAlignment = xlCenter

.VerticalAlignment = xlBottom

End With

With Selection.Borders(xlEdgeLeft)

.LineStyle = xlDouble

.Weight = xlThick

End With

With Selection.Borders(xlEdgeTop)

.LineStyle = xlDouble

.Weight = xlThick

End With

With Selection.Borders(xlEdgeBottom)

.LineStyle = xlDouble

.Weight = xlThick

End With

With Selection.Borders(xlEdgeRight)

.LineStyle = xlDouble

.Weight = xlThick

End With

With Selection.Borders(xlInsideVertical)

.LineStyle = xlContinuous

.Weight = xlThin

End With

If КолУчастников <> 0 Then

With Selection.Borders(xlInsideHorizontal)

.LineStyle = xlContinuous

.Weight = xlThin

End With

End If

Columns("A:A").ColumnWidth = 17

Columns("B:B").ColumnWidth = 25

Columns("C:C").ColumnWidth = 18

Columns("D:D").ColumnWidth = 11

Columns("E:E").ColumnWidth = 15

Columns("F:F").ColumnWidth = 9

Columns("G:G").ColumnWidth = 11

Range("A1").Select

ActiveWorkbook.Save

End Sub