Курсовая работа: Компьютерная подготовка
Все стандартные панели инструментов скрываются и восстанавливаются при открытии / закрытии книги «Телефонный справочник», а также при переключении между окнами. Во избежание проблем с восстановлением стандартного набора панелей инструментов не рекомендуется самостоятельно менять набор отображаемых панелей инструментов пока описываемая книга остается открыта.
При возникновении любой нестандартной ситуации следует закрыть книгу «Телефонный справочник» и выставить нужные панели через меню «Вид».
В ходе выполнения работы были закреплены знания по работе в MS Excel и основам программирования на VBA, а также приобретены практические навыки создания завершенных программных приложений для MS Excel.
Результатом проделанной работы является приложение «Телефонный справочник», функционально выполняющее основные задачи, стоящие перед приложением такого уровня и назначения.
Разумеется, выполненный проект не является завершенным в полной мере. В качестве направлений для развития проекта можно упомянуть, например, более конкретизированный механизм поиска информации или реализация оптимальных методов сортировки (что может быть более эффективным на больших объемах информации).
Потахова И.В. Компьютерная подготовка. Офисное программирование: Учебное пособие. – Томск: Томский межвузовский центр дистанционного образования, 2004. – 181с.
Справочное руководство по MS Excel и Visual Basic for Applications: Microsoft Corp., 2001.
Демидова Л.А., Пылькин А.Н. Программирование в среде Visual Basic for Applications: Практикум – М.: Горячая линия – Телеком, 2004. – 175с.
Приложение. Листинг программ VBA
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
Лист1 (Старт)
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