Смекни!
smekni.com
Информатика и программирование

Компьютерная подготовка (стр. 2 из 2)

При возникновении любой нестандартной ситуации следует закрыть книгу «Телефонный справочник» и выставить нужные панели через меню «Вид».

Заключение

В ходе выполнения работы были закреплены знания по работе в MSExcel и основам программирования на VBA, а также приобретены практические навыки создания завершенных программных приложений для MSExcel.

Результатом проделанной работы является приложение «Телефонный справочник», функционально выполняющее основные задачи, стоящие перед приложением такого уровня и назначения.

Разумеется, выполненный проект не является завершенным в полной мере. В качестве направлений для развития проекта можно упомянуть, например, более конкретизированный механизм поиска информации или реализация оптимальных методов сортировки (что может быть более эффективным на больших объемах информации).

Список литературы

Потахова И.В. Компьютерная подготовка. Офисное программирование: Учебное пособие. – Томск: Томский межвузовский центр дистанционного образования, 2004. – 181с.

Справочноеруководствопо MS Excel и Visual Basic for Applications: Microsoft Corp., 2001.

Демидова Л.А., Пылькин А.Н. Программирование в среде VisualBasicforApplications: Практикум – М.: Горячая линия – Телеком, 2004. – 175с.

Приложение. Листинг программ VBA

Рабочая книга

Dim oldBars(20) As Long, kol As Integer

PrivateSub Workbook_Activate()

kol = 0

Dim bar As CommandBar

ForEach bar In Application.CommandBars

If bar.Visible AndNot (bar.Protection = msoBarNoChangeVisible) _

And (bar.Type = msoBarTypeNormal) AndNot (bar.Name = "Phones") Then

kol = kol + 1

oldBars(kol) = bar.index

EndIf

Next bar

For i = 1To kol

Application.CommandBars(oldBars(i)).Visible = False

Next

If ThisWorkbook.ActiveSheet.Name = "Базаданных"Then

showTools

EndIf

EndSub

PrivateSub Workbook_Deactivate()

Dim i As Integer

For i = kol To1Step -1

Application.CommandBars(oldBars(i)).Visible = True

Next

hideTools

EndSub

PrivateSub Workbook_Open()

ThisWorkbook.Worksheets("Старт").Visible = True' спрятатьстартовыйлист

ThisWorkbook.Worksheets("Старт").Activate ' сделатьактивнымлистсБД

ThisWorkbook.Worksheets("Базаданных").Visible = False' показатьбазуданных

EndSub

Лист1 (Старт)

PrivateSub ExitButton_Click()

ExitProject

EndSub

PrivateSub StartButton_Click()

'Commandbars

ThisWorkbook.Worksheets("Базаданных").Visible = True' показатьбазуданных

ThisWorkbook.Worksheets("База данных").Activate' сделать активным лист с БД

ThisWorkbook.Worksheets("Старт").Visible = False' спрятать стартовый лист

EndSub

Лист2 (База данных)

PrivateSub Worksheet_Activate()

showTools

EndSub

PrivateSub Worksheet_Deactivate()

hideTools

EndSub

Sub addRecord()

If (ActiveCell.row < 5) Or (Len(ActiveCell.EntireRow.Cells(, 1).Value) = 0) Then

Range("A5").Activate

EndIf

ThisWorkbook.ActiveSheet.Unprotect

addRowForm.Show vbModal

ThisWorkbook.ActiveSheet.Protect

EndSub

Sub delRecord()

If (ActiveCell.row < 5) Or (Len(ActiveCell.EntireRow.Cells(, 1).Value) = 0) Then

ExitSub

EndIf

ThisWorkbook.ActiveSheet.Unprotect

If Selection.Rows.count = 1Then

delRowForm.Show vbModal

Else

Dim response

response = MsgBox("Отмеченозаписей: " + Str(Selection.Rows.count) + Chr(13) + "Удалитьвсе?", vbYesNoCancel, "Внимание!")

If response = vbYes Then

Selection.EntireRow.Delete

EndIf

EndIf

ThisWorkbook.ActiveSheet.Protect

EndSub

Sub editRecord()

If (ActiveCell.row < 5) Or (Len(ActiveCell.EntireRow.Cells(, 1).Value) = 0) Then

ExitSub

EndIf

ThisWorkbook.ActiveSheet.Unprotect

editRowForm.Show vbModal

ThisWorkbook.ActiveSheet.Protect

EndSub

Sub sort()

ThisWorkbook.ActiveSheet.Unprotect

sortForm.Show vbModal

ThisWorkbook.ActiveSheet.Protect

EndSub

Sub report()

Dim oldCell As Range

ThisWorkbook.ActiveSheet.Unprotect

Set oldCell = ActiveCell

reportForm.Show vbModal

oldCell.Activate

ThisWorkbook.ActiveSheet.Protect

EndSub

addRowForm

PrivateSub UserForm_Activate()

FamBox.Value = ""

ImBox.Value = ""

OtBox.Value = ""

StreetBox.Value = ""

NoBox.Value = ""

FlatBox.Value = ""

PhoneBox.Value = ""

FamBox.SetFocus

EndSub

PrivateSub CancelButton_Click()

addRowForm.Hide

EndSub

PrivateSub OKButton_Click()

' проверкаинформации

Dim box As Variant, boxes As Variant

boxes = Array(FamBox, ImBox, OtBox, StreetBox, NoBox, PhoneBox)

ForEach box In boxes

IfLen(Trim(box.Value)) = 0Then

box.SetFocus

ExitSub

EndIf

Next box

IfLen(Trim(PhoneBox.Value)) > 10Then

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

EndIf

EndSub

PrivateSub PhoneBox_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

If (KeyAscii < Asc("0")) Or (KeyAscii > Asc("9")) Then

MsgBox"Допускается ввод только цифр!"

KeyAscii.Value = 0

EndIf

EndSub

delRowForm

PrivateSub CancelButton_Click()

delRowForm.Hide

EndSub

PrivateSub OKButton_Click()

' удалениетекущейстроки

ActiveCell.EntireRow.Delete

' скрытиеформы

delRowForm.Hide

EndSub

PrivateSub 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

EndSub

editRowForm

PrivateSub 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

EndSub

PrivateSub CancelButton_Click()

editRowForm.Hide

EndSub

PrivateSub OKButton_Click()

' проверкаинформации

Dim box As Variant, boxes As Variant

boxes = Array(FamBox, ImBox, OtBox, StreetBox, NoBox, PhoneBox)

ForEach box In boxes

IfLen(Trim(box.Value)) = 0Then

box.SetFocus

ExitSub

EndIf

Next box

IfLen(Trim(PhoneBox.Value)) > 10Then

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

EndIf

EndSub

PrivateSub PhoneBox_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

If (KeyAscii < Asc("0")) Or (KeyAscii > Asc("9")) Then

MsgBox"Допускается ввод только цифр!"

KeyAscii.Value = 0

EndIf

EndSub

reportForm

PrivateSub UserForm_Activate()

AllOption.Value = True

OKButton.Caption = "Расчет"

OKButton.SetFocus

EndSub

PrivateSub AllOption_Click()

OKButton.Caption = "Расчет"

EndSub

PrivateSub StreetOption_Click()

OKButton.Caption = "Параметры..."

EndSub

PrivateSub HouseOption_Click()

OKButton.Caption = "Параметры..."

EndSub

PrivateSub CancelButton_Click()

reportForm.Hide

EndSub

PrivateSub OKButton_Click()

Dim myRecord As Record

Dim counter As Long

Dim street AsString, no AsString, title AsString

If AllOption.Value Then

counter = count()

MsgBox"Общее количество абонентов: " + Str(counter)

Else

myRecord = getRecord(ActiveCell.EntireRow)

If StreetOption.Value Then

title = "Отчетпоулице"

street = InputBox("Задайтенаименованиеулицы:", title, myRecord.street)

IfLen(street) > 0Then

street = Trim(street)

counter = count(street)

MsgBox "Количествотелефоновнаулице '" + street + "': " + Str(counter)

EndIf

Else

title = "Отчетподому"

street = InputBox("Задайтенаименованиеулицы:", title, myRecord.street)

IfLen(street) > 0Then

street = Trim(street)

no = InputBox("Улица '" + street + "'" + Chr(10) + "Задайтеномердома:", title, myRecord.no)

IfLen(no) > 0Then

no = Trim(no)

counter = count(street, no)

MsgBox"Количество телефонов в доме '" + street + " " + no + "': " + Str(counter)

EndIf

EndIf

EndIf

EndIf

reportForm.Hide

EndSub

PrivateFunction 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

ForEach 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)

EndIf

EndIf

If doCalc Then counter = counter + 1

Next curRow

count = counter

EndFunction

sortForm

PrivateSub UserForm_Activate()

OKButton.SetFocus

EndSub

PrivateSub CancelButton_Click()

sortForm.Hide

EndSub

PrivateSub 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

EndIf

EndIf

sortForm.Hide

EndSub

Module1

PublicType Record

Fam AsString

Im AsString

Ot AsString

street AsString

no AsString

Flat AsString

Phone As Long

EndType

PublicFunction dbFileName() AsString

dbFileName = ThisWorkbook.Path + "&bsol;phones.db"

EndFunction

Sub ToolbarExitButton()

If ThisWorkbook.ActiveSheet.Name = "Старт"Then

ExitProject

Else

ThisWorkbook.Worksheets("Старт").Visible = True' спрятатьстартовыйлист

ThisWorkbook.Worksheets("Старт").Activate ' сделатьактивнымлистсБД

ThisWorkbook.Worksheets("Базаданных").Visible = False' показатьбазуданных

EndIf

EndSub

Sub ExitProject()

ThisWorkbook.Saved = True

If Application.Workbooks.count = 1Then

Application.Quit 'завершитьработу Excel

Else

ThisWorkbook.Close'завершить работу проекта

EndIf

EndSub

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 ForInputAs #1

row = 1

DoWhileNot 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

EndSub

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

ForEach 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

EndSub

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

EndFunction

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

EndSub

Sub showTools()

Application.CommandBars("Phones").Enabled = True

Application.CommandBars("Phones").Visible = True

EndSub

Sub hideTools()

Application.CommandBars("Phones").Visible = False

Application.CommandBars("Phones").Enabled = False

EndSub

 
назад
1
2
НАПИШИТЕ НАМ
Copyright © Smekni.com. All rigths reserved.