5446-1 (607644), страница 2

Просмтор этого файла доступен только зарегистрированным пользователям. Но у нас супер быстрая регистрация: достаточно только электронной почты!

Текст из файла (страница 2)

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

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

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

addRowForm

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

delRowForm

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

editRowForm

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

reportForm

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

sortForm

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

Module1

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

Характеристики

Список файлов курсовой работы