Согласно заданию программа позволяет рассчитать следующую статистику:
Войдите в режим «Отчет», выберите требуемый отчет и, при необходимости, задайте параметры его формирования. Количество абонентов по заданным реквизитам будет посчитано и отображено в диалоговом окне.
Для завершения работы с программой нажмите кнопку «Выход» на панели инструментов. Лист с базой данной будет скрыт, а появится лист с рекламной заставкой. Для подтверждения выхода повторно выберите кнопку «Выход». Если «Телефонный справочник» был единственной открытой книгой, приложение MS Excel будет полностью закрыто, в противном случае – закроется только книга с описываемой программой.
Внимание. Не забывайте сохранять информацию во внешнем файле, иначе последние корректировки могут быть утеряны.
Все стандартные панели инструментов скрываются и восстанавливаются при открытии / закрытии книги «Телефонный справочник», а также при переключении между окнами. Во избежание проблем с восстановлением стандартного набора панелей инструментов не рекомендуется самостоятельно менять набор отображаемых панелей инструментов пока описываемая книга остается открыта.
При возникновении любой нестандартной ситуации следует закрыть книгу «Телефонный справочник» и выставить нужные панели через меню «Вид».
В ходе выполнения работы были закреплены знания по работе в MS Excel и основам программирования на VBA, а также приобретены практические навыки создания завершенных программных приложений для MS Excel.
Результатом проделанной работы является приложение «Телефонный справочник», функционально выполняющее основные задачи, стоящие перед приложением такого уровня и назначения.
Разумеется, выполненный проект не является завершенным в полной мере. В качестве направлений для развития проекта можно упомянуть, например, более конкретизированный механизм поиска информации или реализация оптимальных методов сортировки (что может быть более эффективным на больших объемах информации).
Dim oldBars(20) As Long, kol As Integer Private Sub Workbook_Activate() kol = 0 Dim bar As CommandBar For Each bar In Application.CommandBars If bar.Visible And Not (bar.Protection = msoBarNoChangeVisible) _ And (bar.Type = msoBarTypeNormal) And Not (bar.Name = "Phones") Then kol = kol + 1 oldBars(kol) = bar.index End If Next bar For i = 1 To kol Application.CommandBars(oldBars(i)).Visible = False Next If ThisWorkbook.ActiveSheet.Name = "База данных" Then showTools End If End Sub Private Sub Workbook_Deactivate() Dim i As Integer For i = kol To 1 Step -1 Application.CommandBars(oldBars(i)).Visible = True Next hideTools End Sub Private Sub Workbook_Open() ThisWorkbook.Worksheets("Старт").Visible = True ' спрятать стартовый лист ThisWorkbook.Worksheets("Старт").Activate ' сделать активным лист с БД ThisWorkbook.Worksheets("База данных").Visible = False ' показать базу данных End Sub
Private Sub ExitButton_Click() ExitProject End Sub Private Sub StartButton_Click() 'Commandbars ThisWorkbook.Worksheets("База данных").Visible = True ' показать базу данных ThisWorkbook.Worksheets("База данных").Activate ' сделать активным лист с БД ThisWorkbook.Worksheets("Старт").Visible = False ' спрятать стартовый лист End Sub
Private Sub Worksheet_Activate() showTools End Sub Private Sub Worksheet_Deactivate() hideTools End Sub Sub addRecord() If (ActiveCell.row < 5) Or (Len(ActiveCell.EntireRow.Cells(, 1).Value) = 0) Then Range("A5").Activate End If ThisWorkbook.ActiveSheet.Unprotect addRowForm.Show vbModal ThisWorkbook.ActiveSheet.Protect End Sub Sub delRecord() If (ActiveCell.row < 5) Or (Len(ActiveCell.EntireRow.Cells(, 1).Value) = 0) Then Exit Sub End If ThisWorkbook.ActiveSheet.Unprotect If Selection.Rows.count = 1 Then delRowForm.Show vbModal Else Dim response response = MsgBox("Отмечено записей: " + Str(Selection.Rows.count) + Chr(13) + "Удалить все?", vbYesNoCancel, "Внимание!") If response = vbYes Then Selection.EntireRow.Delete End If End If ThisWorkbook.ActiveSheet.Protect End Sub Sub editRecord() If (ActiveCell.row < 5) Or (Len(ActiveCell.EntireRow.Cells(, 1).Value) = 0) Then Exit Sub End If ThisWorkbook.ActiveSheet.Unprotect editRowForm.Show vbModal ThisWorkbook.ActiveSheet.Protect End Sub Sub sort() ThisWorkbook.ActiveSheet.Unprotect sortForm.Show vbModal ThisWorkbook.ActiveSheet.Protect End Sub Sub report() Dim oldCell As Range ThisWorkbook.ActiveSheet.Unprotect Set oldCell = ActiveCell reportForm.Show vbModal oldCell.Activate ThisWorkbook.ActiveSheet.Protect End Sub
Private Sub UserForm_Activate() FamBox.Value = "" ImBox.Value = "" OtBox.Value = "" StreetBox.Value = "" NoBox.Value = "" FlatBox.Value = "" PhoneBox.Value = "" FamBox.SetFocus End Sub Private Sub CancelButton_Click() addRowForm.Hide End Sub Private Sub OKButton_Click() ' проверка информации Dim box As Variant, boxes As Variant boxes = Array(FamBox, ImBox, OtBox, StreetBox, NoBox, PhoneBox) For Each box In boxes If Len(Trim(box.Value)) = 0 Then box.SetFocus Exit Sub End If Next box If Len(Trim(PhoneBox.Value)) > 10 Then MsgBox "Более 10 цифр в номере телефона" PhoneBox.SetFocus Else ' заполнение записи из формы Dim myRecord As Record myRecord.Fam = FamBox.Value myRecord.Im = ImBox.Value myRecord.Ot = OtBox.Value myRecord.street = StreetBox.Value myRecord.no = NoBox.Value myRecord.Flat = FlatBox.Value myRecord.Phone = Val(PhoneBox.Value) ' добавление строки на лист и ее заполнение ActiveCell.EntireRow.Insert putRecord ActiveCell.EntireRow, myRecord ' скрытие формы addRowForm.Hide End If End Sub Private Sub PhoneBox_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) If (KeyAscii < Asc("0")) Or (KeyAscii > Asc("9")) Then MsgBox "Допускается ввод только цифр!" KeyAscii.Value = 0 End If
End Sub
Private Sub CancelButton_Click() delRowForm.Hide End Sub Private Sub OKButton_Click() ' удаление текущей строки ActiveCell.EntireRow.Delete ' скрытие формы delRowForm.Hide End Sub Private Sub UserForm_Activate() Dim myRecord As Record myRecord = getRecord(ActiveCell.EntireRow) FamBox.Value = myRecord.Fam ImBox.Value = myRecord.Im OtBox.Value = myRecord.Ot StreetBox.Value = myRecord.street NoBox.Value = myRecord.no FlatBox.Value = myRecord.Flat PhoneBox.Value = myRecord.Phone OKButton.SetFocus End Sub
Private Sub UserForm_Activate() Dim myRecord As Record myRecord = getRecord(ActiveCell.EntireRow) FamBox.Value = myRecord.Fam ImBox.Value = myRecord.Im OtBox.Value = myRecord.Ot StreetBox.Value = myRecord.street NoBox.Value = myRecord.no FlatBox.Value = myRecord.Flat PhoneBox.Value = myRecord.Phone FamBox.SetFocus End Sub Private Sub CancelButton_Click() editRowForm.Hide End Sub Private Sub OKButton_Click() ' проверка информации Dim box As Variant, boxes As Variant boxes = Array(FamBox, ImBox, OtBox, StreetBox, NoBox, PhoneBox) For Each box In boxes If Len(Trim(box.Value)) = 0 Then box.SetFocus Exit Sub End If Next box If Len(Trim(PhoneBox.Value)) > 10 Then MsgBox "Более 10 цифр в номере телефона" PhoneBox.SetFocus Else ' заполнение записи из формы Dim myRecord As Record myRecord.Fam = FamBox.Value myRecord.Im = ImBox.Value myRecord.Ot = OtBox.Value myRecord.street = StreetBox.Value myRecord.no = NoBox.Value myRecord.Flat = FlatBox.Value myRecord.Phone = Val(PhoneBox.Value) ' добавление строки на лист и ее заполнение putRecord ActiveCell.EntireRow, myRecord ' скрытие формы editRowForm.Hide End If End Sub Private Sub PhoneBox_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) If (KeyAscii < Asc("0")) Or (KeyAscii > Asc("9")) Then MsgBox "Допускается ввод только цифр!" KeyAscii.Value = 0 End If End Sub
Private Sub UserForm_Activate() AllOption.Value = True OKButton.Caption = "Расчет" OKButton.SetFocus End Sub Private Sub AllOption_Click() OKButton.Caption = "Расчет" End Sub Private Sub StreetOption_Click() OKButton.Caption = "Параметры..." End Sub Private Sub HouseOption_Click() OKButton.Caption = "Параметры..." End Sub Private Sub CancelButton_Click() reportForm.Hide End Sub Private Sub OKButton_Click() Dim myRecord As Record Dim counter As Long Dim street As String, no As String, title As String If AllOption.Value Then counter = count() MsgBox "Общее количество абонентов: " + Str(counter) Else myRecord = getRecord(ActiveCell.EntireRow) If StreetOption.Value Then title = "Отчет по улице" street = InputBox("Задайте наименование улицы:", title, myRecord.street) If Len(street) > 0 Then street = Trim(street) counter = count(street) MsgBox "Количество телефонов на улице '" + street + "': " + Str(counter) End If Else title = "Отчет по дому" street = InputBox("Задайте наименование улицы:", title, myRecord.street) If Len(street) > 0 Then street = Trim(street) no = InputBox("Улица '" + street + "'" + Chr(10) + "Задайте номер дома:", title, myRecord.no) If Len(no) > 0 Then no = Trim(no) counter = count(street, no) MsgBox "Количество телефонов в доме '" + street + " " + no + "': " + Str(counter) End If End If End If End If reportForm.Hide End Sub Private Function count(Optional street, Optional no) As Long Dim myRecord As Record Dim data As Range, curRow As Range Dim doCalc As Boolean, counter As Long counter = 0 Range("A5").Activate Set data = ActiveCell.CurrentRegion For Each curRow In data.Rows myRecord = getRecord(curRow) doCalc = False If IsMissing(street) Then ' все абоненты doCalc = True Else If IsMissing(no) Then ' по улице doCalc = (Trim(myRecord.street) = street) Else ' по дому doCalc = (Trim(myRecord.street) = street) And (Trim(myRecord.no) = no) End If End If If doCalc Then counter = counter + 1 Next curRow count = counter End Function
Private Sub UserForm_Activate() OKButton.SetFocus End Sub Private Sub CancelButton_Click() sortForm.Hide End Sub Private Sub OKButton_Click() Dim sht As Worksheet Dim rng As Range Set sht = ThisWorkbook.ActiveSheet Set rng = sht.Range(sht.Cells(5, 1), sht.Cells(65536, 1).End(xlUp).Offset(, 7)) If NameOption.Value Then ' сортировать по ФИО rng.sort Key1:=sht.Columns("A"), Order1:=xlAscending, Key2:=sht.Columns("B"), Order2:=xlAscending, Key3:=sht.Columns("C"), Order3:=xlAscending, Header:=xlNo Else If AddressOption.Value Then ' сортировать по адресу rng.sort Key1:=sht.Columns("D"), Order1:=xlAscending, Key2:=sht.Columns("E"), Order2:=xlAscending, Key3:=sht.Columns("F"), Order3:=xlAscending, Header:=xlNo Else ' сортировать по телефону rng.sort Key1:=sht.Columns("G"), Order1:=xlAscending, Header:=xlNo End If End If sortForm.Hide End Sub
Public Type Record Fam As String Im As String Ot As String street As String no As String Flat As String Phone As Long End Type Public Function dbFileName() As String dbFileName = ThisWorkbook.Path + "\phones.db" End Function Sub ToolbarExitButton() If ThisWorkbook.ActiveSheet.Name = "Старт" Then ExitProject Else ThisWorkbook.Worksheets("Старт").Visible = True ' спрятать стартовый лист ThisWorkbook.Worksheets("Старт").Activate ' сделать активным лист с БД ThisWorkbook.Worksheets("База данных").Visible = False ' показать базу данных End If End Sub Sub ExitProject() ThisWorkbook.Saved = True If Application.Workbooks.count = 1 Then Application.Quit 'завершить работу Excel Else ThisWorkbook.Close 'завершить работу проекта End If End Sub Sub dbRead() ThisWorkbook.ActiveSheet.Unprotect Dim myRecord As Record Dim data As Range, curRow As Range Dim row As Integer Range("A5").Activate Set data = ActiveCell.CurrentRegion data.ClearContents Open dbFileName For Input As #1 row = 1 Do While Not EOF(1) Input #1, myRecord.Fam, myRecord.Im, myRecord.Ot, myRecord.street, myRecord.no, myRecord.Flat, myRecord.Phone putRecord ActiveCell.Cells(row), myRecord row = row + 1 Loop Close #1 ThisWorkbook.ActiveSheet.Protect End Sub Sub dbWrite() ThisWorkbook.ActiveSheet.Unprotect Dim myRecord As Record Dim data As Range, curRow As Range Range("A5").Activate Set data = ActiveCell.CurrentRegion Open dbFileName For Output As #1 For Each curRow In data.Rows myRecord = getRecord(curRow) Write #1, myRecord.Fam, myRecord.Im, myRecord.Ot, myRecord.street, myRecord.no, myRecord.Flat, myRecord.Phone Next curRow Close #1 ThisWorkbook.ActiveSheet.Protect End Sub Function getRecord(row As Range) As Record Dim myRecord As Record myRecord.Fam = row.Cells(, 1).Value myRecord.Im = row.Cells(, 2).Value myRecord.Ot = row.Cells(, 3).Value myRecord.street = row.Cells(, 4).Value myRecord.no = row.Cells(, 5).Value myRecord.Flat = row.Cells(, 6).Value myRecord.Phone = row.Cells(, 7).Value getRecord = myRecord End Function Sub putRecord(row As Range, myRecord As Record) row.Cells(, 1).Value = myRecord.Fam row.Cells(, 2).Value = myRecord.Im row.Cells(, 3).Value = myRecord.Ot row.Cells(, 4).Value = myRecord.street row.Cells(, 5).Value = myRecord.no row.Cells(, 6).Value = myRecord.Flat row.Cells(, 7).Value = myRecord.Phone End Sub Sub showTools() Application.CommandBars("Phones").Enabled = True Application.CommandBars("Phones").Visible = True End Sub Sub hideTools() Application.CommandBars("Phones").Visible = False Application.CommandBars("Phones").Enabled = False End Sub
Страницы: 1, 2