Автоматизация работы секретариата Федерации художественной гимнастики с помощью MS Excel

   "b2:b" & NomerStroki + 1), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _

   xlSortNormal

   With ActiveWorkbook.Worksheets("АрхивГимнасток ").Sort

   .SetRange Range("b2:f" & NomerStroki + 1)

   .Header = xlYes

   .MatchCase = False

   .Orientation = xlTopToBottom

   .SortMethod = xlPinYin

   .Apply

   End With 

   Range("A1:F1").Select

  End Sub 

  Sub NaidennayaGimnastka() 'Найденная гимнастка

   Dim name As String

   

   name = АнкетаУчастниц.ListBox1.Text

   

   Sheets("АрхивГимнасток ").Select

   NomerStroki = Application.CountA(Sheets("АрхивГимнасток ").Range("a:a"))

   

   For i = 3 To NomerStroki

   If Cells(i, 2).Value = name Then

   АнкетаУчастниц.TextBox1.Text = Cells(i, 2).Value

   АнкетаУчастниц.TextBox2.Text = Cells(i, 3).Value

   АнкетаУчастниц.TextBox3.Text = Cells(i, 4).Value

   АнкетаУчастниц.ComboBox1.Text = Cells(i, 5).Value

   АнкетаУчастниц.TextBox5.Text = Cells(i, 6).Value

   End If

   Next i

  End Sub 

  Sub SpisokGimnastok() 'Список гимнасток

   

   Sheets("АрхивГимнасток ").Select

   NomerStroki = Application.CountA(Sheets("АрхивГимнасток ").Range("a:a"))

   ReDim spisok(NomerStroki - 2)

   i = 1

   АнкетаУчастниц.ListBox1.Clear

   For i = 1 To NomerStroki - 2

   spisok(i) = Cells(i + 2, 2).Value

   АнкетаУчастниц.ListBox1.AddItem (spisok(i))

   Next i

   

  End Sub 

  Sub ObnovitDannyePoGimnastke() 'Обновить данные по гимнастке

   Dim name As String

   

   name = АнкетаУчастниц.ListBox1.Text

   

   Sheets("АрхивГимнасток ").Select

   NomerStroki = Application.CountA(Sheets("АрхивГимнасток ").Range("a:a"))

   

   For i = 3 To NomerStroki

   If Cells(i, 2).Value = name Then

   Cells(i, 2).Value = АнкетаУчастниц.TextBox1.Text

   Cells(i, 3).Value = АнкетаУчастниц.TextBox2.Text

   Cells(i, 4).Value = АнкетаУчастниц.TextBox3.Text

   Cells(i, 5).Value = АнкетаУчастниц.ComboBox1.Text

   Cells(i, 6).Value = АнкетаУчастниц.TextBox5.Text

   End If

   Next i

  End Sub 

  Sub FormirovanieProtokolaSorevnovaniy() 'Формирование протокола соревнований 

   Sheets("ПротоколСоревнований(инд)").Select

   

   If Cells(1, 1).Value = "" Then

   

   Range("A3").Select

   ActiveCell.FormulaR1C1 = "№"

   Range("B3").Select

   ActiveCell.FormulaR1C1 = "Фамилия Имя"

   Range("C3").Select

   ActiveCell.FormulaR1C1 = "Область, край"

   Range("D3").Select

   ActiveCell.FormulaR1C1 = "Город"

   Range("E3").Select

   ActiveCell.FormulaR1C1 = "Разряд"

   Range("F3").Select

   ActiveCell.FormulaR1C1 = "Год"

   

   Range("M3").Select

   ActiveCell.FormulaR1C1 = "Сумма" & Chr(10) & "баллов"

   Range("N3").Select

   ActiveCell.FormulaR1C1 = "Место"

   

   Range("A1:N1").Select

   

   Selection.Merge

   ActiveCell.FormulaR1C1 = "ФЕДЕРАЦИЯ ХУДОЖЕСТВЕННОЙ ГИМНАСТИКИ" & Chr(10) & Соревнования.TextBox1.Text

   

   Range("A2:N2").Select

   

   Selection.Merge

   Range("A2:N2").Select

   ActiveCell.FormulaR1C1 = "г. " & Соревнования.TextBox2.Text & " " & Соревнования.TextBox3.Text

   Selection.Font.Italic = True

   Rows("1:1").Select

   Application.WindowState = xlMinimized

   Selection.RowHeight = 80

   Range("A1:N1").Select

   

   

   Range("A1:N1").Select

   Selection.Font.Italic = True

   

   Range("A1:N3").Select

   With Selection.Font

   .name = "Arial Cyr"

   .Size = 14

   .Strikethrough = False

   .Superscript = False

   .Subscript = False

   .OutlineFont = False

   .Shadow = False

   .Underline = xlUnderlineStyleNone

   .ThemeColor = xlThemeColorLight1

   .TintAndShade = 0

   .ThemeFont = xlThemeFontNone

   End With

   Rows("3:3").EntireRow.AutoFit

   With Selection

   .VerticalAlignment = xlCenter

   .Orientation = 0

   .AddIndent = False

   .IndentLevel = 0

   .ShrinkToFit = False

   .ReadingOrder = xlContext

   End With

   With Selection

   .VerticalAlignment = xlBottom

   .Orientation = 0

   .AddIndent = False

   .IndentLevel = 0

   .ShrinkToFit = False

   .ReadingOrder = xlContext

   End With

   With Selection

   .VerticalAlignment = xlCenter

   .Orientation = 0

   .AddIndent = False

   .IndentLevel = 0

   .ShrinkToFit = False

   .ReadingOrder = xlContext

   End With

   With Selection

   .HorizontalAlignment = xlGeneral

   .VerticalAlignment = xlCenter

   .Orientation = 0

   .AddIndent = False

   .IndentLevel = 0

   .ShrinkToFit = False

   .ReadingOrder = xlContext

   End With

   With Selection

   .HorizontalAlignment = xlCenter

   .VerticalAlignment = xlCenter

   .Orientation = 0

   .AddIndent = False

   .IndentLevel = 0

   .ShrinkToFit = False

   .ReadingOrder = xlContext

   End With

   Columns("A:M").EntireColumn.AutoFit

   

   Range("A3:N3").Select

   Selection.Borders(xlDiagonalDown).LineStyle = xlNone

   Selection.Borders(xlDiagonalUp).LineStyle = xlNone

   With Selection.Borders(xlEdgeLeft)

   .LineStyle = xlContinuous

   .ColorIndex = 0

   .TintAndShade = 0

   .Weight = xlThin

   End With

   With Selection.Borders(xlEdgeTop)

   .LineStyle = xlContinuous

   .ColorIndex = 0

   .TintAndShade = 0

   .Weight = xlThin

   End With

   With Selection.Borders(xlEdgeBottom)

   .LineStyle = xlContinuous

   .ColorIndex = 0

   .TintAndShade = 0

   .Weight = xlThin

   End With

   With Selection.Borders(xlEdgeRight)

   .LineStyle = xlContinuous

   .ColorIndex = 0

   .TintAndShade = 0

   .Weight = xlThin

   End With

   With Selection.Borders(xlInsideVertical)

   .LineStyle = xlContinuous

   .ColorIndex = 0

   .TintAndShade = 0

   .Weight = xlThin

   End With

   With Selection.Borders(xlInsideHorizontal)

   .LineStyle = xlContinuous

   .ColorIndex = 0

   .TintAndShade = 0

   .Weight = xlThin

   End With

   

   Range("A4").Select

   End If

  End Sub 

  Sub SohranenieGimnastkiVProtokol() 'Сохранение гимнастки в протокол 

   Sheets("СписокУчастниц").Select

   NomerStroki = Application.CountA(Sheets("СписокУчастниц").Range("d:d")) + 11

   

   If NomerStroki = 11 Then

   Cells(12, 4).Value = 1

   Else

   Cells(NomerStroki + 1, 4).Value = NomerStroki - 10

   End If

   

   Cells(NomerStroki + 1, 5).Value = АнкетаУчастниц.TextBox1.Text

   Cells(NomerStroki + 1, 6).Value = АнкетаУчастниц.TextBox2.Text

   Cells(NomerStroki + 1, 7).Value = АнкетаУчастниц.TextBox3.Text

   Cells(NomerStroki + 1, 8).Value = АнкетаУчастниц.ComboBox1.Text

   Cells(NomerStroki + 1, 9).Value = АнкетаУчастниц.TextBox5.Text

   

   Range(Cells(12, 4), Cells(NomerStroki + 1, 9)).Select 

  Range("A4").Select

   

  End Sub 

  Sub SpisokUchastnic() 'Список участниц

   

   Sheets("АрхивГимнасток ").Select

   NomerStroki = Application.CountA(Sheets("АрхивГимнасток ").Range("a:a"))

   ReDim spisok(NomerStroki - 2)

   i = 1

   ЛичнаяКарточка.ListBox1.Clear

   For i = 1 To NomerStroki - 2

   spisok(i) = Cells(i + 2, 2).Value

   ЛичнаяКарточка.ListBox1.AddItem (spisok(i))

   Next i

   

  End Sub 

  Sub NaidennayaUchastnica() 'Найденная участница

   Dim name As String

   

   name = ЛичнаяКарточка.ListBox1.Text

   

   Sheets("АрхивГимнасток ").Select

   NomerStroki = Application.CountA(Sheets("АрхивГимнасток ").Range("a:a"))

   

   For i = 3 To NomerStroki

   If Cells(i, 2).Value = name Then

   ЛичнаяКарточка.TextBox3.Text = Cells(i, 3).Value

   ЛичнаяКарточка.TextBox4.Text = Cells(i, 4).Value

   ЛичнаяКарточка.TextBox5.Text = Cells(i, 5).Value

   ЛичнаяКарточка.TextBox6.Text = Cells(i, 6).Value

   End If

   Next i

  End Sub 

  Sub ItogovayaOcenka() 'Итоговая оценка

   Dim BP As Single

   Dim Sk As Single

   Dim Obr As Single

   Dim Myach As Single

   Dim Bul As Single

   Dim Lent As Single

   

   BP = CSng(ЛичнаяКарточка.TextBox23.Text)

   Sk = CSng(ЛичнаяКарточка.TextBox176.Text)

   Obr = CSng(ЛичнаяКарточка.TextBox351.Text)

   Myach = CSng(ЛичнаяКарточка.TextBox376.Text)

   Bul = CSng(ЛичнаяКарточка.TextBox401.Text)

   Lent = CSng(ЛичнаяКарточка.TextBox426.Text)

   

   ЛичнаяКарточка.TextBox432.Text = BP + Sk + Obr + Myach + Bul + Lent