Требования к оформлению дз 2 и 3

Отчет по ДЗ должен быть сдан в электронном и печатном виде и включать в себя:

1. Титульный лист (пустые строки недопустимы! Вспоминаем интервалы! ).

2. Оглавление.

3. Постановку задачи (задание, которое Вы получили от меня).

4. Листинг программы, напечатанный в редакторе VBA(или в редактореWord: шрифт –Courier, 10 пунктов).

5. План тестирования программы.

6. Придуманное Вами задание.

7. Главы должны быть пронумерованы. Стиль заголовков – Заголовок 1. Если в главах имеются параграфы, то стиль заголовка должен соответствовать их уровню.

8. Электронная версия отчета должна быть оформлена согласно стандартам и принципам, изложенным в курсе «Офисные программные пакеты».

При невыполнении этих требований домашняя работа считается невыполненной и к защите не принимается!

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

Эта книга:

ption Base 1

Dim КнигаОткрыта As Integer

Dim ИмяФайла As String

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

Sub Workbook_BeforeClose(Cancel As Boolean)

For Each bar In Application.CommandBars

If (bar.Name = "НоваяПанель") Then

bar.Delete

Exit For

End If

Next

ОткрытаЛиКнига Файл2

If КнигаОткрыта = -1 Then

ActiveWorkbook.SaveAs Ôàéë2

Else

Сообщение = vbYesNo + vbQuestion

Ответ = MsgBox(("Файл уже существует.Заменить?"), Сообщение)

Select Case Ответ

Case vbNo

Exit Sub

End

Case vbYes

Kill Ôàéë2

ActiveWorkbook.SaveAs Ôàéë2

End

End Select

End If

End Sub

Sub Workbook_Open()

Call ДобавитьПанель

End Sub

Sub ДобавитьПанель()

Set Panel = Application.CommandBars.Add

With Panel

.Name = "НоваяПанель"

.Visible = True

.Position = msoBarTop

End With

Set FirstButton = Panel.Controls.Add(Type:=msoControlButton)

With FirstButton

.Style = msoButtonCaption

.Caption = "О программе"

.Enabled = True

.OnAction = "ShowAuthor"

End With

Set SecondButton = Panel.Controls.Add(Type:=msoControlButton)

With SecondButton

.Style = msoButtonCaption

.Caption = "Фитнес"

.Enabled = True

.OnAction = "Main"

End With

End Sub

Frm forma:

Sub cboClubList_Change()

Dim КолСтанций As Integer

Dim Станции() As String

Dim p As Integer

КолСтанций = 1

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

ReDim Preserve Станции(1) As String

While p = 0

If Trim(Cells(НомерСтроки, 1).Value) = cboClubList.Value Then

Станции(1) = Trim(Cells(НомерСтроки, 2).Value)

p = 3

End If

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

Wend

'Кусок кода выше присваивет начальное значение массиву, которое соответсвует условию выбора значения из первого ComBoxa

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

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

If Trim(Cells(НомерСтроки, 1).Value) = cboClubList.Value Then

Станция = Trim(Cells(НомерСтроки, 2).Value)

For j = 1 To КолСтанций

If Станция = Станции(j) Then GoTo n1

Next j

КолСтанций = КолСтанций + 1

ReDim Preserve Станции(КолСтанций) As String

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

End If

n1: НомерСтроки = НомерСтроки + 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

' Сортируем список

frmForma.cboMetroList.List = Станции

frmForma.cboMetroList.ListIndex = 0

End Sub

Private Sub cboMetroList_Change()

КолЗаписей = 0

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

Станция2 = cboMetroList.Value

Êëóá2 = cboClubList.Value

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

If cboClubList.Value = Trim(Cells(НомерСтроки, 1).Value) Then

If Trim(Cells(НомерСтроки, 2).Value) = cboMetroList.Value Then

КолЗаписей = КолЗаписей + 1

End If

End If

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

Wend

' Узнаем кол переносымых записей

ReDim Preserve OurTable(КолЗаписей)

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

j = 1

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

If Trim(Cells(НомерСтроки, 1).Value) = cboClubList.Value Then

If Trim(Cells(НомерСтроки, 2).Value) = cboMetroList.Value Then

OurTable(j).Day = Trim(Cells(НомерСтроки, 6).Value)

OurTable(j).Time = Trim(Cells(НомерСтроки, 5).Value)

OurTable(j).Class = Trim(Cells(НомерСтроки, 3).Value)

OurTable(j).Look = Trim(Cells(НомерСтроки, 4).Value)

j = j + 1

End If

End If

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

Wend

' Записываем в наш тип данных, данные удолетворяющие условия...

End Sub

Private Sub cmdCancel_Click()

Unload Me

End Sub

Sub cmdOK_Click()

MsgBox "Записей " & КолЗаписей

Dim Path, PathToFile, FileName As String

Path = "E:\Фитнес\" & cboMetroList.Value

Папка = Dir(Path, vbDirectory)

Файл2 = "E:\Фитнес\" & cboMetroList.Value & "\" & cboClubList.Value & ".xls"

If Папка <> "" Then

Else: MkDir Path

End If

Application.SheetsInNewWorkbook = 1

Workbooks.Add

ActiveSheet.Name = Date

Cells(2, 1).Value = "¹"

Cells(2, 2).Value = "День недели"

Cells(2, 3).Value = "Начало тренировок"

Cells(2, 4).Value = "Направление"

Cells(2, 5).Value = "Вид нагрузок"

' В новом файле создаем "шапку"

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

For j = 1 To КолЗаписей

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

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

Cells(НомерСтроки, 3).Value = OurTable(j).Time

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

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

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

Next j

Call Mac

End Sub

Модуль 1:

Option Base 1

Type НовыйТип

Class As String

Time As String

Day As String

Look As String

End Type

Private Sub ShowAuthor()

frmAutor.Show

End Sub

Sub ОткрытаЛиКнига(Файл)

ИмяФайла = Dir(Файл)

If ИмяФайла <> "" Then

For Each ОткрытыеКниги In Workbooks

If ИмяФайла = ОткрытыеКниги.Name Then

КнигаОткрыта = 1

Exit For

Else

КнигаОткрыта = 0

End If

Next ОткрытыеКниги

Else

КнигаОткрыта = -1

Exit Sub

End If

' Метод возвращает 1 - если книга открыта, 0 - если закрыта, -1 - если не существует.

End Sub

Sub Main()

Dim Клуб, Клубы() As String

Dim КолКлубов As Integer

Файл = "E:\Фитнес\Фитнес-клубы.xls"

ОткрытаЛиКнига Файл

If КнигаОткрыта = 1 Then

Workbooks("Фитнес-клубы.xls").Activate

ElseIf КнигаОткрыта = 0 Then

Workbooks.Open FileName:=Ôàéë

Else

MsgBox "Книги не существует"

Exit Sub

End If

' Проверяем состояние исходного файла

ReDim Preserve Клубы(1) As String

Клубы(1) = Trim(Cells(2, 1).Value)

КолКлубов = 1

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

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

Клуб = Trim(Cells(НомерСтроки, 1).Value)

For j = 1 To КолКлубов

If Клуб = Клубы(j) Then GoTo n2

Next j

КолКлубов = КолКлубов + 1

ReDim Preserve Клубы(КолКлубов) As String

Клубы(КолКлубов) = Trim(Cells(НомерСтроки, 1).Value)

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

Wend

' Составляем список всех данных клубов

For i = 1 To КолКлубов

Клуб = Клубы(i)

k = i

For j = i + 1 To КолКлубов

If Клубы(j) >= Клуб Then

Else

Клуб = Клубы(j)

Клубы(j) = Клубы(k)

Клубы(k) = Клуб

End If

Next

Next i

' Сортируем список клубов

frmForma.cboClubList.List = Клубы

frmForma.cboClubList.ListIndex = 0

frmForma.Show

End Sub

Sub Mac()

'

Range("A1:E1").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("A1:F5").Select

Range("F5").Activate

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

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

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

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

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

Range("A1:E5").Select

Range("E5").Activate

With Selection

.HorizontalAlignment = xlCenter

.VerticalAlignment = xlBottom

.WrapText = False

.Orientation = 0

.AddIndent = False

.IndentLevel = 0

.ShrinkToFit = False

.ReadingOrder = xlContext

End With

Range("G6").Select

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

Columns("D:D").Select

Range("D2").Activate

Selection.ColumnWidth = 16.14

Range("A1:E7").Select

Range("E7").Activate

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

Range("F12").Select

End Sub