.Weight = xlMedium

.ColorIndex = xlAutomatic

End With

With Selection.Borders(xlEdgeTop)

.LineStyle = xlContinuous

.Weight = xlMedium

.ColorIndex = xlAutomatic

End With

With Selection.Borders(xlEdgeBottom)

.LineStyle = xlContinuous

.Weight = xlMedium

.ColorIndex = xlAutomatic

End With

With Selection.Borders(xlEdgeRight)

.LineStyle = xlContinuous

.Weight = xlMedium

.ColorIndex = xlAutomatic

End With

With Selection.Borders(xlInsideVertical)

.LineStyle = xlContinuous

.Weight = xlThin

.ColorIndex = xlAutomatic

End With

With Selection

.HorizontalAlignment = xlCenter

.VerticalAlignment = xlCenter

.WrapText = True

.Orientation = 0

.AddIndent = False

.IndentLevel = 0

.ShrinkToFit = False

.ReadingOrder = xlContext

.MergeCells = False

End With

With Selection.Font

.FontStyle = "полужирный"

.Size = 8

.Strikethrough = False

.Superscript = False

.Subscript = False

.OutlineFont = False

.Shadow = False

End With

End Sub

Sub NewZa()

ex = 1

Workbooks("Main.xls").Worksheets("Заказы").Activate

i = 3

Do

i = i + 1

Loop While Cells(i, 1).Value <> ""

If Cells(4, 1).Value = "" Then

num = 1

Else

num = Cells(i - 1, 1).Value + 1

End If

Range(Cells(i, 1), Cells(i, 18)).Select

With Selection

.HorizontalAlignment = xlCenter

.VerticalAlignment = xlCenter

.WrapText = True

.Orientation = 0

.AddIndent = False

.IndentLevel = 0

.ShrinkToFit = False

.ReadingOrder = xlContext

.MergeCells = False

End With

With Selection.Font

.Name = "Arial Cyr"

.FontStyle = "полужирный"

.Size = 8

.Strikethrough = False

.Superscript = False

.Subscript = False

.OutlineFont = False

.Shadow = False

.Underline = xlUnderlineStyleNone

.ColorIndex = xlAutomatic

End With

Selection.Borders(xlDiagonalDown).LineStyle = xlNone

Selection.Borders(xlDiagonalUp).LineStyle = xlNone

With Selection.Borders(xlEdgeLeft)

.LineStyle = xlContinuous

.Weight = xlMedium

.ColorIndex = xlAutomatic

End With

With Selection.Borders(xlEdgeTop)

.LineStyle = xlContinuous

.Weight = xlMedium

.ColorIndex = xlAutomatic

End With

With Selection.Borders(xlEdgeBottom)

.LineStyle = xlContinuous

.Weight = xlMedium

.ColorIndex = xlAutomatic

End With

With Selection.Borders(xlEdgeRight)

.LineStyle = xlContinuous

.Weight = xlMedium

.ColorIndex = xlAutomatic

End With

With Selection.Borders(xlInsideVertical)

' .LineStyle = xlContinuous

.Weight = xlThin

'.ColorIndex = xlAutomatic

End With

Cells(i, 1).Value = num

With frmNewZakaz

.txt1.Text = ""

.txt2.Text = ""

.txt3.Text = ""

.DTPicker1.Value = "01.01.1900"

.txt5.Text = ""

.TextBox2.Text = ""

.obm.Value = False

.obj.Value = False

.chb1.Value = False

.chb2.Value = False

.chb3.Value = False

.txt6.Text = ""

.txt7.Text = ""

.txt6.Enabled = False

.txt7.Enabled = False

.TextBox3.Text = ""

.TextBox4.Text = ""

.TextBox5.Text = ""

.TextBox6.Text = ""

.TextBox7.Text = ""

.TextBox8.Text = ""

.TextBox9.Text = ""

.TextBox10.Text = ""

.TextBox11.Text = ""

.ComboBox1.Value = ""

.ComboBox2.Value = ""

.ComboBox3.Value = ""

End With

frmNewZakaz.Show

If ex = 0 Then

Selection.Delete

Exit Sub

End If

Workbooks("Firms").Unprotect Password:="Firms1"

ActiveSheet.Unprotect Password:="list"

i = 6

Str1 = i

With Workbooks("Firms.xls").Worksheets(frmNewZakaz.ComboBox2.Value)

.Unprotect Password:="list"

num = .Index

ie = .Range("End" & num).Row

For ib = .Range("Beg" & num).Row + 1 To ie

If CStr(.Cells(ib, 1).Value) = frmNewZakaz.ComboBox3.Value And .Cells(ib, 1).MergeCells = True Then

Str1 = .Cells(ib, 1).Row

Exit For

End If

Next ib

For Str1 = .Cells(ib, 1).Row To ie

If CStr(.Cells(Str1, 1).Value) = frmNewZakaz.ComboBox1.Value And .Cells(Str1, 1).MergeCells = False Then

.Cells(Str1, 2) = .Cells(Str1, 2) - CInt(frmNewZakaz.TextBox8.Text)

.Cells(Str1, 4) = .Cells(Str1, 4) - CInt(frmNewZakaz.TextBox9.Text)

Exit For

End If

Next Str1

' .Protect Password:="list", DrawingObjects:=True, Contents:=True, Scenarios:=True, _

AllowFormattingCells:=True, AllowFormattingColumns:=True, AllowFormattingRows:=True

End With

' ActiveSheet.Protect Password:="list", DrawingObjects:=True, Contents:=True, Scenarios:=True, _

AllowFormattingCells:=True, AllowFormattingColumns:=True, AllowFormattingRows:=True

' Workbooks("Firms").Protect Password:="Firms1"

End Sub

Sub EditZa()

Workbooks("Main.xls").Worksheets("Заказы").Activate

If Cells(4, 1) = "" Then

MsgBox "Нечего редактировать.", vbCritical, "Ошибка!"

Exit Sub

End If

Kol_Prstr2 = 3

Kol_Prstr = 4

Do

flag = 0

Workbooks("Main").Worksheets("Заказы").Activate

Строка = InputBox("Введите номер заказа, который хотите изменить: ", _

"Ввод номера заказа")

If Строка = "" Then Exit Sub

If Строка < 0 Or Строка = 0 Then

MsgBox "Нет такого номера заказа в базе.", vbCritical, "Ошибка!"

flag = 1

End If

If IsNumeric(Строка) = False Then

MsgBox "Введите номер заказа в формате числа", vbCritical, "Ошибка!"

flag = 1

End If

Loop While flag = 1

i = 3

flaj = 0

Do

i = i + 1

If Cells(i, 1).Value = CInt(Строка) Then

flaj = 1

Exit Do

End If

Loop While Cells(i, 1).Value <> ""

If flaj = 0 Then

MsgBox "В базе нет такого номера заказа", vbCritical, "Ошибка!"

Exit Sub

End If

ex = 1

Workbooks("Firms").Unprotect Password:="Firms1"

ActiveSheet.Unprotect Password:="list"

Range(Cells(i, 1), Cells(i, 18)).Select

temp = i

With frmNewZakaz

.Caption = "Редактирование заказа"

.txt1.Text = Cells(temp, 2)

.txt2.Text = Cells(temp, 3)

.txt3.Text = Cells(temp, 4)

.DTPicker1.Value = Cells(temp, 6)

.txt5.Text = Cells(temp, 7)

.TextBox2.Text = Cells(temp, 8)

If Cells(temp, 5) = "Муж" Then .obm.Value = True

If Cells(temp, 5) = "Жен" Then .obj.Value = True

If Cells(temp, 14).Value = "Оплачено" Then .chb1.Value = True

If Cells(temp, 15).Value = "Сдано" Then .chb2.Value = True

If Cells(temp, 12).Value = "Да" Then

.chb3.Value = True

.txt6.Text = Left(Cells(temp, 13), 4)

.txt7.Text = Right(Cells(temp, 13), 6)

End If

.ComboBox2.Value = Cells(temp, 9) 'фирма

.ComboBox3.Value = Cells(temp, 10) 'страна

.ComboBox1.Value = Cells(temp, 11) 'город

.TextBox8.Text = Cells(temp, 16)

.TextBox9.Text = Cells(temp, 17)

End With

i = 6

Str1 = i

tempoNe = CStr(Cells(temp, 9).Value)

With Workbooks("Firms.xls").Worksheets(CStr(Cells(temp, 9).Value))

.Unprotect Password:="list"

num = .Index

ie = .Range("End" & num).Row

For ib = .Range("Beg" & num).Row + 1 To ie

If CStr(.Cells(ib, 1).Value) = Workbooks("Main.xls").Worksheets("Заказы").Cells(temp, 10) _

And .Cells(ib, 1).MergeCells = True Then

StrNe1 = .Cells(ib, 1).Row

Exit For

End If

Next ib

For StrNe1 = .Cells(ib, 1).Row + 1 To ie

If CStr(.Cells(StrNe1, 1).Value) = Workbooks("Main.xls").Worksheets("Заказы").Cells(temp, 11).Value _

And .Cells(StrNe1, 1).MergeCells = False Then

regvzr = .Cells(StrNe1, 2) + Workbooks("Main.xls").Worksheets("Заказы").Cells(temp, 16)

regdet = .Cells(StrNe1, 4) + Workbooks("Main.xls").Worksheets("Заказы").Cells(temp, 17)

Exit For

End If

' .Protect Password:="list", DrawingObjects:=True, Contents:=True, Scenarios:=True, _

AllowFormattingCells:=True, AllowFormattingColumns:=True, AllowFormattingRows:=True

Next StrNe1

End With

frmNewZakaz.TextBox3 = Workbooks("Firms.xls").Worksheets(CStr(Cells(temp, 9).Value)).Cells(StrNe1, 2)

frmNewZakaz.TextBox4 = Workbooks("Firms.xls").Worksheets(CStr(Cells(temp, 9).Value)).Cells(StrNe1, 4)

frmNewZakaz.TextBox5 = Workbooks("Firms.xls").Worksheets(CStr(Cells(temp, 9).Value)).Cells(StrNe1, 3)

frmNewZakaz.TextBox6 = Workbooks("Firms.xls").Worksheets(CStr(Cells(temp, 9).Value)).Cells(StrNe1, 5)

frmNewZakaz.TextBox7 = Workbooks("Firms.xls").Worksheets(CStr(Cells(temp, 9).Value)).Cells(StrNe1, 6)

frmNewZakaz.TextBox10 = Workbooks("Firms.xls").Worksheets(CStr(Cells(temp, 9).Value)).Cells(StrNe1, 7)

frmNewZakaz.Show

If ex = 0 Then Exit Sub

With Workbooks("Firms.xls").Worksheets(tempoNe)

.Cells(StrNe1, 2) = regvzr

.Cells(StrNe1, 4) = regdet

End With

With Workbooks("Firms.xls").Worksheets(frmNewZakaz.ComboBox2.Value)

.Unprotect Password:="list"

num = .Index

ie = .Range("End" & num).Row

For ib = .Range("Beg" & num).Row + 1 To ie

If CStr(.Cells(ib, 1).Value) = frmNewZakaz.ComboBox3.Value _

And .Cells(ib, 1).MergeCells = True Then

Str1 = .Cells(ib, 1).Row

Exit For

End If

Next ib

For Str1 = .Cells(ib, 1).Row To ie

If CStr(.Cells(Str1, 1).Value) = frmNewZakaz.ComboBox1.Value _

And .Cells(Str1, 1).MergeCells = False Then

.Cells(Str1, 2).Value = .Cells(Str1, 2).Value _

- CInt(Workbooks("Main.xls").Worksheets("Заказы").Cells(temp, 16))

.Cells(Str1, 4).Value = .Cells(Str1, 4).Value _

- CInt(Workbooks("Main.xls").Worksheets("Заказы").Cells(temp, 17))

Exit For

End If

' .Protect Password:="list", DrawingObjects:=True, Contents:=True, Scenarios:=True, _

AllowFormattingCells:=True, AllowFormattingColumns:=True, AllowFormattingRows:=True

Next Str1

End With

' ActiveSheet.Protect Password:="list", DrawingObjects:=True, Contents:=True, Scenarios:=True, _

AllowFormattingCells:=True, AllowFormattingColumns:=True, AllowFormattingRows:=True

' Workbooks("Firms").Protect Password:="Firms1"

End Sub

Sub DelZa()

Workbooks("Main.xls").Worksheets("Заказы").Activate

If Cells(4, 1) = "" Then

MsgBox "Нечего удалять.", vbCritical, "Ошибка!"

Exit Sub

End If

Do

flag = 0

Workbooks("Main").Worksheets("Заказы").Activate

Строка = InputBox("Введите номер заказа, который хотите удалить: ", _

"Ввод номера заказа")

If Строка = "" Then Exit Sub

If Строка < 0 Or Строка = 0 Then

MsgBox "Нет такого номера заказа в базе.", vbCritical, "Ошибка!"

flag = 1

End If

If IsNumeric(Строка) = False Then

MsgBox "Введите номер заказа в формате числа", vbCritical, "Ошибка!"

flag = 1

End If

Loop While flag = 1

i = 3

flaj = 0

Do

i = i + 1

If Cells(i, 1).Value = CInt(Строка) Then

flaj = 1

Exit Do

End If

Loop While Cells(i, 1).Value <> ""

If flaj = 0 Then

MsgBox "В базе нет такого номера заказа", vbCritical, "Ошибка!"

Exit Sub

End If

Workbooks("Firms").Unprotect Password:="Firms1"

ActiveSheet.Unprotect Password:="list"

Ответ = MsgBox("Подтверждаете удаление заказа № " & Строка & "?", vbInformation + vbYesNo, "Внимание!")

If Ответ = vbNo Then Exit Sub

ex = 1

Range(Cells(i, 1), Cells(i, 18)).Select

With Workbooks("Firms.xls").Worksheets(Workbooks("Main.xls").Worksheets("Заказы").Cells(i, 9).Value)

.Unprotect Password:="list"

num = .Index

ie = .Range("End" & num).Row

For ib = .Range("Beg" & num).Row + 1 To ie

If CStr(.Cells(ib, 1).Value) = Workbooks("Main.xls").Worksheets("Заказы").Cells(i, 10) _

And .Cells(ib, 1).MergeCells = True Then

Str1 = .Cells(ib, 1).Row

Exit For

End If

Next ib

For Str1 = .Cells(ib, 1).Row To ie

If CStr(.Cells(Str1, 1).Value) = Workbooks("Main.xls").Worksheets("Заказы").Cells(i, 11) _

And .Cells(Str1, 1).MergeCells = False Then

.Cells(Str1, 2) = .Cells(Str1, 2) + CInt(Workbooks("Main.xls").Worksheets("Заказы").Cells(i, 16))

.Cells(Str1, 4) = .Cells(Str1, 4) + CInt(Workbooks("Main.xls").Worksheets("Заказы").Cells(i, 17))

Exit For

End If

Next Str1

' .Protect Password:="list", DrawingObjects:=True, Contents:=True, Scenarios:=True, _

AllowFormattingCells:=True, AllowFormattingColumns:=True, AllowFormattingRows:=True

End With

' ActiveSheet.Protect Password:="list", DrawingObjects:=True, Contents:=True, Scenarios:=True, _

AllowFormattingCells:=True, AllowFormattingColumns:=True, AllowFormattingRows:=True

' Workbooks("Firms").Protect Password:="Firms1"

Selection.Delete

End Sub

Sub MainS()

Workbooks("Main.xls").Worksheets("1").Activate

Main.Show

End Sub

Sub ShowPut()

Workbooks("Main.xls").Worksheets("ПоискПутевки").Activate

i = 4

Do

If i = 4 And Cells(i, 1).Value = "" Then Exit Do

i = i + 1

Loop While Cells(i, 1).Value <> ""

Range(Cells(4, 1), Cells(i, 12)).Delete

Find.Show

End Sub

//Workbook(“Firms.xls”).Worksheets(“1”)

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

SubMain.Show

End Sub

//Workbook(“Firms.xls”)

Private Sub Workbook_Open()

' Workbooks("Firms").Protect Password:="Firms1"

MenuBars(xlWorksheet).Menus.Add Caption:="&Работа с фирмами", Before:=10

MenuBars(xlWorksheet).Menus("&Работа с фирмами").MenuItems.Add _

Caption:="&Перейти в меню фирм", Before:=2, OnAction:="SubMainS"

MenuBars(xlWorksheet).Menus("Работа с фирмами").MenuItems.AddMenu _

"Добавление"

MenuBars(xlWorksheet).Menus("Работа с фирмами").MenuItems("Добавление").MenuItems.Add "Новую фирму", OnAction:="NewFirmLo"

MenuBars(xlWorksheet).Menus("Работа с фирмами").MenuItems("Добавление").MenuItems.Add "Путевку в базу", OnAction:="NewPut"

MenuBars(xlWorksheet).Menus("Работа с фирмами").MenuItems.AddMenu _

"Редактирование"

MenuBars(xlWorksheet).Menus("Работа с фирмами").MenuItems("Редактирование").MenuItems.Add "Данных о фирме", OnAction:="EditFirm"

MenuBars(xlWorksheet).Menus("Работа с фирмами").MenuItems("Редактирование").MenuItems.Add "Путевку в базе", OnAction:="EditPut"

MenuBars(xlWorksheet).Menus("Работа с фирмами").MenuItems.AddMenu _

"Поиск/Переход"

MenuBars(xlWorksheet).Menus("Работа с фирмами").MenuItems("Поиск/Переход").MenuItems.Add "Перейти на определенную фирму", OnAction:="ShowList"

MenuBars(xlWorksheet).Menus("Работа с фирмами").MenuItems("Поиск/Переход").MenuItems.Add "Выделить опред. город опред. страны", OnAction:="ShowCountry"

MenuBars(xlWorksheet).Menus("Работа с фирмами").MenuItems.AddMenu _

"Удаление"

MenuBars(xlWorksheet).Menus("Работа с фирмами").MenuItems("Удаление").MenuItems.Add "Фирму из базы", OnAction:="DeleteFirm"

MenuBars(xlWorksheet).Menus("Работа с фирмами").MenuItems("Удаление").MenuItems.Add "Путевку из базы", OnAction:="DeleteCoun"

End Sub

//Workbook(“Firms.xls”) Форма frmDelCoun

Private Sub ComboBox2_Change()

k = 0

num = Worksheets(ActiveSheet.Name).Index

ie = Range("End" & num).Row

ComboBox3.Clear

For ib = Range("Beg" & num).Row + 1 To ie

If ComboBox2.Value = Cells(ib, 1).Value And Cells(ib, 1).MergeCells = True Then

k = Cells(ib, 1).Row

Exit For

End If

Next ib

k = k + 1

temp = k

Do While Cells(k, 1).MergeCells = False And k <> Range("End" & num).Row

ComboBox3.AddItem Cells(k, 1).Value

k = k + 1

Loop

End Sub

Private Sub CommandButton1_Click()

num = ActiveSheet.Index

ie = Range("End" & num).Row

If ie = 6 Then

MsgBox "Нет стран для удаления!", vbCritical, "Ошибка"

Me.Hide

Exit Sub

End If

CommandButton1.Caption = "Удалить страну и ее города - выбрано"

ComboBox1.Enabled = True

CommandButton1.Enabled = False

CommandButton2.Enabled = False

CommandButton3.Enabled = True

ComboBox3.Enabled = False

ComboBox2.Enabled = False

CommandButton4.Enabled = False

num = ActiveSheet.Index

ie = Range("End" & num).Row

For ib = Range("Beg" & num).Row + 1 To ie

If Cells(ib, 1).MergeCells = True Then

ComboBox1.AddItem Cells(ib, 1).Value

End If

Next ib

End Sub

Private Sub CommandButton2_Click()

num = ActiveSheet.Index

ie = Range("End" & num).Row

If ie = 6 Then

MsgBox "Нет стран для удаления!", vbCritical, "Ошибка"

Me.Hide

Exit Sub

End If

CommandButton2.Caption = "Удалить город определенной страны-выбрано"

CommandButton1.Enabled = False

CommandButton4.Enabled = True

ComboBox1.Enabled = False

ComboBox2.Enabled = True

ComboBox3.Enabled = True

CommandButton2.Enabled = False

For ib = Range("Beg" & num).Row + 1 To ie

If Cells(ib, 1).MergeCells = True Then

ComboBox2.AddItem Cells(ib, 1).Value

End If

Next ib

End Sub

Private Sub CommandButton3_Click()

num = ActiveSheet.Index

ie = Range("End" & num).Row

If ie = 6 Then

MsgBox "Нет стран для удаления!", vbCritical, "Ошибка"

Me.Hide

Exit Sub

End If

If ComboBox1.Value = "" Then

MsgBox "Выберите страну для удаления!", vbCritical, "Ошибка!"

Exit Sub

End If

flag = 0

For ib = Range("Beg" & num).Row + 1 To ie

If Cells(ib, 1).Value = ComboBox1.Value And Cells(ib, 1).MergeCells = True Then flag = 1

Next ib

If flag = 0 Then

MsgBox "В базе нет такой страны!", vbOKOnly, "Ошибка!"

Exit Sub

End If

For ib = Range("Beg" & num).Row + 1 To ie

If Cells(ib, 1).Value = ComboBox1.Value And Cells(ib, 1).MergeCells = True Then

строка = Cells(ib, 1).Row

Exit For

End If

Next ib

needStr = строка + 1

Do While Cells(needStr, 1).MergeCells = False And needStr <> ie

needStr = needStr + 1

Loop

Ответ = MsgBox("Подтверждаете удаление страны (" & ComboBox1.Value & ") и всех ее городов?", vbInformation + vbYesNo, "Внимание!")

If Ответ = vbYes Then

Range(Cells(строка, 1), Cells(needStr - 1, 10)).Delete

Me.Hide

Exit Sub

Else

Me.Hide

Exit Sub

End If

End Sub

Private Sub CommandButton4_Click()

temp = 0

num = ActiveSheet.Index

ie = Range("End" & num).Row

If ie = 6 Then

MsgBox "Нет стран для удаления!", vbCritical, "Ошибка"

Me.Hide

Exit Sub

End If

If ComboBox2.Value = "" Or ComboBox3.Value = "" Then

MsgBox "Выбраны не все данные!", vbCritical, "Ошибка!"

Exit Sub

End If

flag = 0

For ib = Range("Beg" & num).Row + 1 To ie

If Cells(ib, 1).Value = ComboBox2.Value And Cells(ib, 1).MergeCells = True Then flag = 1

Next ib

If flag = 0 Then

MsgBox "В базе нет такой страны!", vbOKOnly, "Ошибка!"

Exit Sub

End If

For ib = Range("Beg" & num).Row + 1 To ie

If Cells(ib, 1) = ComboBox2.Value And Cells(ib, 1).MergeCells = True Then

temp = ib ' начало страны

Exit For

End If

Next ib

temp = temp + 1

flag2 = 0

Do While Cells(temp, 1).MergeCells = False And temp <> Range("End" & num).Row

If ComboBox3.Value = Cells(temp, 1).Value Then

flag2 = 1

Exit Do

End If

temp = temp + 1

Loop

If flag2 = 0 Then

MsgBox "Нет такого города для этой страны в списке...", vbOKOnly, "Ошибка!"

ComboBox2.Value = ""

Exit Sub

End If

Range(Cells(temp, 1), Cells(temp, 10)).Select

Ответ = MsgBox("Подтверждаете удаление города (" & ComboBox3.Value _

& ") страны (" & ComboBox2.Value & ")?", vbInformation + vbYesNo, "Внимание!")

If Ответ = vbYes Then

Selection.Delete

Me.Hide

Exit Sub

Else

Me.Hide

Exit Sub

End If

Me.Hide

End Sub

Private Sub UserForm_Activate()

Workbooks("Firms").Unprotect Password:="Firms1"

ActiveSheet.Unprotect Password:="list"

ComboBox1.Clear

ComboBox2.Clear

ComboBox3.Clear

ComboBox1.Enabled = False

ComboBox2.Enabled = False

ComboBox3.Enabled = False

CommandButton3.Enabled = False

CommandButton4.Enabled = False

CommandButton1.Enabled = True

CommandButton2.Enabled = True

End Sub

Private Sub UserForm_Initialize()

Workbooks("Firms").Unprotect Password:="Firms1"

ActiveSheet.Unprotect Password:="list"

End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

If Cancel = 0 Then ex = 0

End Sub

//Workbook(“Firms.xls”) Форма frmEditFirm

Option Compare Text

Dim ptemp As String

Private Sub cmbOK_Click()

Dim SA(1 To 7) As Integer

SA(1) = InStr(txtNaim.Text, ":")

SA(2) = InStr(txtNaim.Text, "/")

SA(3) = InStr(txtNaim.Text, "\")

SA(4) = InStr(txtNaim.Text, "?")

SA(5) = InStr(txtNaim.Text, "*")

SA(6) = InStr(txtNaim.Text, "[")

SA(7) = InStr(txtNaim.Text, "]")

n = Len(txtNaim.Text)

For i = 1 To 7

If SA(i) > 0 Or n > 31 Then

MsgBox "Имя должно быть не более 31 знака. И не содержать символов : / \ ? * [ ]", vbOKOnly, "Ошибка!"

Exit Sub

End If

Next i

temp = ActiveSheet.Name

If txtNaim.Text = "" Then

MsgBox "Наименование не может быть пустым!", vbCritical, "Ошибка"

Exit Sub

End If

For Each Sheet In Workbooks("Firms.xls").Worksheets

If Sheet.Name = frmEditFirm.txtNaim.Text And Sheet.Name <> temp Then fl = 1

Next Sheet

If fl = 1 Then

MsgBox "В базе имеется фирма с таким именем!", vbCritical, "Ошибка!"

Exit Sub

End If

Me.Hide

End Sub

Private Sub UserForm_Activate()

Workbooks("Firms").Unprotect Password:="Firms1"

ActiveSheet.Unprotect Password:="list"

lblNaim.ControlTipText = _

"Имя должно быть не более 31 знака. И не содержать символов : / \ ? * [ ]"

End Sub

Private Sub UserForm_Deactivate()

txtNaim.Text = ""

txtAdr.Text = ""

txtTel1.Text = ""

txtTel2.Text = ""

txtSite.Text = ""

End Sub

Private Sub UserForm_Initialize()

Workbooks("Firms").Unprotect Password:="Firms1"

ActiveSheet.Unprotect Password:="list"

End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

If Cancel = 0 Then ex = 0

End Sub

//Workbook(“Firms.xls”) Форма frmNewPut

Option Compare Text

Dim temp As Integer

Private Sub CommandButton1_Click()

Label1.Enabled = True

Label2.Enabled = True

TextBox1.Enabled = True

TextBox2.Enabled = True

CommandButton4.Enabled = False

CommandButton3.Enabled = True

CommandButton1.Caption = "Добавить путевку" & Chr(13) & "(новая страна и город)-выбрано"

CommandButton2.Caption = "Добавить путевку (новый город)"

ComboBox1.Enabled = False

TextBox3.Enabled = False

End Sub

Private Sub CommandButton2_Click()

' новый город

num = ActiveSheet.Index

If Range("End" & num).Row = 6 Then

MsgBox "В базе нет ни одной страны...", vbOKOnly, "Ошибка!"

CommandButton1_Click

Exit Sub

End If

Label3.Enabled = True

Label4.Enabled = True

ComboBox1.Enabled = True

TextBox1.Enabled = False

TextBox2.Enabled = False

TextBox3.Enabled = True

CommandButton3.Enabled = False

CommandButton4.Enabled = True

' ComboBox1.MatchRequired = True

' ComboBox1.MatchEntry = fmMatchEntryComplete

CommandButton2.Caption = "Добавить путевку (новый город)-выбрано"

CommandButton1.Caption = "Добавить путевку" & Chr(13) & "(новая страна и город)"

num = ActiveSheet.Index

ie = Range("End" & num).Row

For ib = Range("Beg" & num).Row + 1 To ie

If Cells(ib, 1).MergeCells = True Then

ComboBox1.AddItem Cells(ib, 1).Value

End If

Next ib

End Sub

Private Sub CommandButton3_Click() ' новая страна и город

num = ActiveSheet.Index

ie = Range("End" & num).Row

For ib = Range("Beg" & num).Row + 1 To ie

If Cells(ib, 1).Value = TextBox1.Text And Cells(ib, 1).MergeCells = True Then

MsgBox "В базе имеется такая страна для этой фирмы!", vbOKOnly, "Ошибка!"

TextBox1.Text = ""

Exit Sub

End If

Next ib

If TextBox1.Text = "" Or TextBox2.Text = "" Then

MsgBox "Введите необходимые поля ввода!", vbOKOnly, "Ошибка!"

Exit Sub

End If

Range("End" & Worksheets(ActiveSheet.Name).Index).Select

Selection.EntireRow.Insert

Selection.EntireRow.Insert

ie = Range("End" & num).Row

Range(Cells(ie - 2, 1), Cells(ie - 1, 10)).Select

Selection.Interior.ColorIndex = xlNone

Range(Cells(ie - 2, 1), Cells(ie - 2, 10)).Select

With Selection

.HorizontalAlignment = xlCenter

.VerticalAlignment = xlCenter

.WrapText = True

.Orientation = 0

.AddIndent = False

.IndentLevel = 0

.ShrinkToFit = False

.ReadingOrder = xlContext

.MergeCells = False

End With

Selection.Merge

Selection.Borders(xlDiagonalDown).LineStyle = xlNone

Selection.Borders(xlDiagonalUp).LineStyle = xlNone

With Selection.Borders(xlEdgeLeft)

.LineStyle = xlContinuous

.Weight = xlMedium

.ColorIndex = xlAutomatic

End With

With Selection.Borders(xlEdgeTop)

.LineStyle = xlContinuous

.Weight = xlMedium

.ColorIndex = xlAutomatic

End With

With Selection.Borders(xlEdgeBottom)

.LineStyle = xlContinuous

.Weight = xlMedium

.ColorIndex = xlAutomatic

End With

With Selection.Borders(xlEdgeRight)

.LineStyle = xlContinuous

.Weight = xlMedium

.ColorIndex = xlAutomatic

End With

With Selection.Borders(xlInsideVertical)

.LineStyle = xlContinuous

.Weight = xlThin

.ColorIndex = xlAutomatic

End With

Cells(ie - 2, 1).Value = TextBox1.Text

Cells(ie - 1, 1).Value = TextBox2.Text

Me.Hide

frmPInfo.Label1.Caption = ActiveSheet.Name

frmPInfo.TextBox1.Text = Cells(ie - 2, 1).Value

frmPInfo.TextBox2.Text = Cells(ie - 1, 1).Value

ex = 1

frmPInfo.Show

With frmPInfo

If .TextBox5.Value = "" Then .TextBox5.Value = 0

If .TextBox6.Value = "" Then .TextBox6.Value = 0

If .TextBox7.Value = "" Then .TextBox7.Value = 0

If .TextBox3.Value = "" Then .TextBox3.Value = 0

If .TextBox4.Value = "" Then .TextBox4.Value = 0

Cells(ie - 1, 3).Value = CDbl(.TextBox5.Text)

Cells(ie - 1, 5).Value = CDbl(.TextBox6.Text)

Cells(ie - 1, 6).Value = CDbl(.TextBox7.Text)

Cells(ie - 1, 2).Value = CInt(.TextBox3.Text)

Cells(ie - 1, 4).Value = CInt(.TextBox4.Text)

Cells(ie - 1, 8).Value = CStr(.TextBox8.Text)

Cells(ie - 1, 10).Value = CStr(.TextBox9.Text)

If frmPInfo.OptionButton1 = True Then

Cells(ie - 1, 7).Value = CInt(7)

End If

If frmPInfo.OptionButton2 = True Then

Cells(ie - 1, 7).Value = CInt(14)

End If

If frmPInfo.OptionButton3 = True Then

Cells(ie - 1, 7).Value = CInt(21)

End If

If frmPInfo.OptionButton4 = True Then

Cells(ie - 1, 9).Value = CInt(1)

End If

If frmPInfo.OptionButton5 = True Then

Cells(ie - 1, 9).Value = CInt(5)

End If

If frmPInfo.OptionButton6 = True Then

Cells(ie - 1, 9).Value = CInt(2)

End If

If frmPInfo.OptionButton7 = True Then

Cells(ie - 1, 9).Value = CInt(3)

End If

If frmPInfo.OptionButton8 = True Then

Cells(ie - 1, 9).Value = CInt(4)

End If

End With

If ex = 0 Then Exit Sub

With frmPInfo

.TextBox5.Value = ""

.TextBox6.Text = ""

.TextBox7.Text = ""

.TextBox3.Text = ""

.TextBox4.Text = ""

.TextBox8.Text = ""

.TextBox9.Text = ""

.OptionButton1 = False

.OptionButton2 = False

.OptionButton3 = False

.OptionButton4 = False

.OptionButton5 = False

.OptionButton6 = False

.OptionButton7 = False

.OptionButton8 = False

End With

End Sub

Private Sub CommandButton4_Click() ' новый город

temp = 0

temp2 = 0

num = ActiveSheet.Index

ie = Range("End" & num).Row

flag = 0

For ib = Range("Beg" & num).Row + 1 To ie

If CStr(Cells(ib, 1).Value) = ComboBox1.Value And Cells(ib, 1).MergeCells = True Then flag = 1

Next ib

If flag = 0 Then

MsgBox "В базе нет такой страны!", vbOKOnly, "Ошибка!"

Exit Sub

End If

If TextBox3.Text = "" Then

MsgBox "Введите необходимые поля ввода!", vbOKOnly, "Ошибка!"

Exit Sub

End If

For ib = Range("Beg" & num).Row + 1 To ie

If Cells(ib, 1) = ComboBox1.Value And Cells(ib, 1).MergeCells = True Then

temp = ib ' начало страны

Exit For

End If

Next ib

temp2 = temp

temp = temp + 1

Do While Cells(temp, 1).MergeCells = False And temp <> Range("End" & num).Row

If Cells(temp, 1).Value = TextBox3.Text Then

MsgBox "В базе имеется город для выбранной страны!", vbOKOnly, "Ошибка!"

TextBox3.Text = ""

Exit Sub

End If

temp = temp + 1

Loop

Cells(temp2 + 1, 1).Select

Selection.EntireRow.Insert

Cells(temp2 + 1, 1).Value = TextBox3.Text

Range(Cells(temp2 + 1, 1), Cells(temp2 + 1, 10)).Select

Selection.Borders(xlDiagonalDown).LineStyle = xlNone

Selection.Borders(xlDiagonalUp).LineStyle = xlNone

With Selection.Borders(xlEdgeLeft)

.LineStyle = xlContinuous

.Weight = xlMedium

.ColorIndex = xlAutomatic

End With

With Selection.Borders(xlEdgeTop)

.LineStyle = xlContinuous

.Weight = xlMedium

.ColorIndex = xlAutomatic

End With

With Selection.Borders(xlEdgeBottom)

.LineStyle = xlContinuous

.Weight = xlThin

.ColorIndex = xlAutomatic

End With

With Selection.Borders(xlEdgeRight)

.LineStyle = xlContinuous

.Weight = xlMedium

.ColorIndex = xlAutomatic

End With

With Selection.Borders(xlInsideVertical)

.LineStyle = xlContinuous

.Weight = xlThin

.ColorIndex = xlAutomatic

End With

Me.Hide

frmPInfo.Label1.Caption = ActiveSheet.Name

frmPInfo.TextBox1.Text = frmNewPut.ComboBox1.Value

frmPInfo.TextBox2.Text = frmNewPut.TextBox3.Text

ex = 1

frmPInfo.Show

With frmPInfo

If .TextBox5.Value = "" Then .TextBox5.Value = 0

If .TextBox6.Value = "" Then .TextBox6.Value = 0

If .TextBox7.Value = "" Then .TextBox7.Value = 0

If .TextBox3.Value = "" Then .TextBox3.Value = 0

If .TextBox4.Value = "" Then .TextBox4.Value = 0

Cells(temp2 + 1, 3).Value = CDbl(.TextBox5.Value)

Cells(temp2 + 1, 5).Value = CDbl(.TextBox6.Text)

Cells(temp2 + 1, 6).Value = CDbl(.TextBox7.Text)

Cells(temp2 + 1, 2).Value = CInt(.TextBox3.Text)

Cells(temp2 + 1, 4).Value = CInt(.TextBox4.Text)

Cells(temp2 + 1, 8).Value = CStr(.TextBox8.Text)

Cells(temp2 + 1, 10).Value = CStr(.TextBox9.Text)

If .OptionButton1 = True Then

Cells(temp2 + 1, 7).Value = CInt(7)

End If

If .OptionButton2 = True Then

Cells(temp2 + 1, 7).Value = CInt(14)

End If

If .OptionButton3 = True Then

Cells(temp2 + 1, 7).Value = CInt(21)

End If

If .OptionButton4 = True Then

Cells(temp2 + 1, 9).Value = CInt(1)

End If

If .OptionButton5 = True Then

Cells(temp2 + 1, 9).Value = CInt(5)

End If

If .OptionButton6 = True Then

Cells(temp2 + 1, 9).Value = CInt(2)

End If

If .OptionButton7 = True Then

Cells(temp2 + 1, 9).Value = CInt(3)

End If

If .OptionButton8 = True Then

Cells(temp2 + 1, 9).Value = CInt(4)

End If

End With

If ex = 0 Then Exit Sub

With frmPInfo

.TextBox5.Value = ""

.TextBox6.Text = ""

.TextBox7.Text = ""

.TextBox3.Text = ""

.TextBox4.Text = ""

.TextBox8.Text = ""

.TextBox9.Text = ""

.OptionButton1 = False

.OptionButton2 = False

.OptionButton3 = False

.OptionButton4 = False

.OptionButton5 = False

.OptionButton6 = False

.OptionButton7 = False

.OptionButton8 = False

End With

End Sub

Private Sub UserForm_Activate()

Workbooks("Firms").Unprotect Password:="Firms1"

ActiveSheet.Unprotect Password:="list"

TextBox1.Value = ""

TextBox2.Value = ""

ComboBox1.Clear

TextBox3.Value = ""

CommandButton3.Enabled = False

CommandButton4.Enabled = False

Label1.Enabled = False

Label2.Enabled = False

TextBox1.Enabled = False

TextBox2.Enabled = False

Label3.Enabled = False

Label4.Enabled = False

ComboBox1.Enabled = False

TextBox3.Enabled = False

CommandButton1.Caption = "Добавить путевку" & Chr(13) & "(новая страна и город)"

CommandButton2.Caption = "Добавить путевку (новый город)"

CommandButton1.Enabled = True

CommandButton2.Enabled = True

End Sub

Private Sub UserForm_Initialize()

Workbooks("Firms").Unprotect Password:="Firms1"

ActiveSheet.Unprotect Password:="list"

End Sub

//Workbook(“Firms.xls”) Форма frmPInfo

Option Compare Text

Private Sub CommandButton1_Click()

' If TextBox3.Text = "" Or TextBox4.Text = "" Or _

' TextBox5.Text = "" Or TextBox6.Text = "" Or _

' TextBox7.Text = "" Then

' MsgBox "Введите расценки и количества мест !", vbOKOnly, "Ошибка!"

' Exit Sub

' End If

' If OptionButton1.Value = False And OptionButton2.Value = False And _

' OptionButton3.Value = False Then

' MsgBox "Выберите длительность путевки!", vbOKOnly, "Ошибка!"

' Exit Sub

' End If

' If TextBox8.Text = "" Then

' MsgBox "Введите название отеля!", vbOKOnly, "Ошибка!"

' Exit Sub

' End If

' If OptionButton4.Value = False And OptionButton5.Value = False And _

' OptionButton6.Value = False And OptionButton7.Value = False And _

' OptionButton8.Value = False Then

' MsgBox "Выберите количество звезд отеля!", vbOKOnly, "Ошибка!"

' Exit Sub

' End If

If IsNumeric(TextBox3.Text) = False And TextBox3.Text <> "" _

Or IsNumeric(TextBox4.Text) = False And TextBox4.Text <> "" _

Or IsNumeric(TextBox5.Text) = False And TextBox5.Text <> "" _

Or IsNumeric(TextBox6.Text) = False And TextBox6.Text <> "" _

Or IsNumeric(TextBox7.Text) = False And TextBox7.Text <> "" Then

MsgBox "Проверьте правильность формата введенных данных", vbCritical + vbOKOnly, "Ошибка!"

Exit Sub

End If

Me.Hide

End Sub

Private Sub UserForm_Activate()

Workbooks("Firms").Unprotect Password:="Firms1"

ActiveSheet.Unprotect Password:="list"

End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

If Cancel = 0 Then ex = 0

End Sub

//Workbook(“Firms.xls”) Форма frmSelPut

Dim k, m As Integer

Dim temp As Integer

Dim num As Integer

Dim ie As Integer

Private Sub ComboBox1_Change()

k = 0

num = Worksheets(ActiveSheet.Name).Index

ie = Range("End" & num).Row

ComboBox2.Clear

For ib = Range("Beg" & num).Row + 1 To ie

If ComboBox1.Value = CStr(Cells(ib, 1).Value) And Cells(ib, 1).MergeCells = True Then

k = Cells(ib, 1).Row

Exit For

End If

Next ib

k = k + 1

temp = k

Do While Cells(k, 1).MergeCells = False And k <> Range("End" & num).Row

ComboBox2.AddItem Cells(k, 1).Value

k = k + 1

Loop

End Sub

Private Sub CommandButton5_Click()

If ComboBox1.Value = "" And ComboBox2.Value = "" Then

MsgBox "Выберите страну/город. Определитесь уже.", vbCritical, "Ошибка!"

Exit Sub

End If

If ComboBox2.Value = "" And ComboBox1.Value <> "" Then

MsgBox "Выберите город.", vbCritical, "Ошибка!"

Exit Sub

End If

If ComboBox1.Value = "" And ComboBox2.Value <> "" Then

MsgBox "Выберите страну.", vbCritical, "Ошибка!"

Exit Sub

End If

If ComboBox1.Value <> "" And ComboBox2.Value <> "" Then

flag = 0

For ib = Range("Beg" & num).Row + 1 To ie

If CStr(Cells(ib, 1).Value) = ComboBox1.Value And Cells(ib, 1).MergeCells = True Then

flag = 1

Exit For

End If

Next ib

If flag = 0 Then

MsgBox "Нет такой страны в списке...", vbOKOnly, "Ошибка!"

ComboBox1.Value = ""

ComboBox2.Value = ""

Exit Sub

End If

flag2 = 0

Do While Cells(temp, 1).MergeCells = False And temp <> Range("End" & num).Row

If ComboBox2.Value = CStr(Cells(temp, 1).Value) Then

flag2 = 1

Exit Do

End If

temp = temp + 1

Loop

If flag2 = 0 Then

MsgBox "Нет такого города для этой страны в списке...", vbOKOnly, "Ошибка!"

ComboBox2.Value = ""

Exit Sub

End If

Range(Cells(temp, 1), Cells(temp, 10)).Select

Me.Hide

End If

If ComboBox1.Value <> "" And ComboBox2.Value = "" Then

For ib = Range("Beg" & num).Row + 1 To ie

If CStr(Cells(ib, 1).Value) = ComboBox1.Value And Cells(ib, 1).MergeCells = True Then

NR = Cells(ib, 1).Row

flag = 1

Exit For

End If

Next ib

If flag = 0 Then

MsgBox "Нет такой страны в списке...", vbOKOnly, "Ошибка!"

ComboBox1.Value = ""

ComboBox2.Value = ""

Exit Sub

End If

Worksheets(ActiveSheet.Name).Cells(NR, 1).Select

Me.Hide

End If

End Sub

Private Sub UserForm_Activate()

Workbooks("Firms").Unprotect Password:="Firms1"

ActiveSheet.Unprotect Password:="list"

ComboBox1.Clear

ComboBox2.Clear

num = Worksheets(ActiveSheet.Name).Index

ie = Range("End" & num).Row

For ib = Range("Beg" & num).Row + 1 To ie

If Cells(ib, 1).MergeCells = True Then

ComboBox1.AddItem Cells(ib, 1).Value

End If

Next ib

End Sub

Private Sub UserForm_Deactivate()

ComboBox1.Clear

ComboBox2.Clear

End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

If Cancel = 0 Then ex = 0

End Sub

//Workbook(“Firms.xls”) Форма listFirm

Private Sub CommandButton1_Click()

flag = 0

For Each Sheet In Workbooks("Firms.xls").Worksheets

If Sheet.Name = ComboBox1.Value Then flag = 1

Next Sheet

If flag = 0 Then

MsgBox "Нет такой фирмы в базе...", vbCritical, "Ошибка!"

Exit Sub

End If

Me.Hide

Workbooks("Firms.xls").Worksheets(ComboBox1.Value).Activate

End Sub

Private Sub UserForm_Activate()

ComboBox1.Clear

For Each Sheet In Workbooks("Firms.xls").Worksheets

If Sheet.Name <> "1" Then

ComboBox1.AddItem Sheet.Name

End If

Next Sheet

End Sub

Private Sub UserForm_Deactivate()

ComboBox1.Clear

End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

If Cancel = 0 Then ex = 0

End Sub

//Workbook(“Firms.xls”) Форма NewFirm

Option Compare Text

Private Sub cmbOK_Click()

Dim SA(1 To 7) As Integer

SA(1) = InStr(txtNaim.Text, ":")

SA(2) = InStr(txtNaim.Text, "/")

SA(3) = InStr(txtNaim.Text, "\")

SA(4) = InStr(txtNaim.Text, "?")

SA(5) = InStr(txtNaim.Text, "*")

SA(6) = InStr(txtNaim.Text, "[")

SA(7) = InStr(txtNaim.Text, "]")

n = Len(txtNaim.Text)

For i = 1 To 7

If SA(i) > 0 Or n > 31 Then

MsgBox "Имя должно быть не более 31 знака." & Chr(13) & "И не содержать символов : / \ ? * [ ]", vbCritical, "Ошибка!"

Exit Sub

End If

Next i

If txtNaim.Text = "" Then

MsgBox "Наименование не может быть пустым!", vbCritical, "Ошибка"

Worksheets("1").Activate

Exit Sub

End If

For Each Sheet In ActiveWorkbook.Sheets

If Sheet.Name = txtNaim.Text Then

MsgBox "Страница с таким именем уже существует!", vbCritical, "Ошибка"

Exit Sub

End If

Next Sheet

Workbooks("Firms").Unprotect Password:="Firms1"

Workbooks("Firms").Activate

Sheets.Add.Move after:=Worksheets(Worksheets.Count)

Range("A1:E1").Select

Selection.HorizontalAlignment = xlCenter

Selection.VerticalAlignment = xlBottom

Selection.NumberFormat = "General"

With Selection.Font

.Name = "Arial"

.FontStyle = "полужирный"

.Size = 8

.Strikethrough = False

.Superscript = False

.Subscript = False

.OutlineFont = False

.Shadow = False

.Underline = xlUnderlineStyleNone

.ColorIndex = xlAutomatic

End With

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.Interior

.ColorIndex = 39

.Pattern = xlSolid

.PatternColorIndex = xlAutomatic

End With

Range("A1").Value = txtNaim.Text

Range("B1").Value = txtAdr.Text

Range("C1").Value = txtTel1.Text

Range("D1").Value = txtTel2.Text

Range("E1").Value = txtSite.Text

Range("A1:E1").Select

With Selection

.HorizontalAlignment = xlCenter

.VerticalAlignment = xlCenter

.WrapText = True

.Orientation = 0

.AddIndent = False

.IndentLevel = 0

.ShrinkToFit = False

.ReadingOrder = xlContext

.MergeCells = False

End With

Range("A3:J3").Select

With Selection.Font

.Name = "Arial"

.Size = 14

.Strikethrough = False

.Superscript = False

.Subscript = False

.OutlineFont = False

.Shadow = False

.Underline = xlUnderlineStyleNone

.ColorIndex = xlAutomatic

End With

Selection.Font.Bold = True

Selection.Font.Italic = True

ActiveCell.FormulaR1C1 = "Путевки"

Range("A3:J3").Select

Range("B3").Activate

With Selection

.HorizontalAlignment = xlCenter

.VerticalAlignment = xlBottom

.WrapText = False

.Orientation = 0

.AddIndent = False

.IndentLevel = 0

.ShrinkToFit = False

.ReadingOrder = xlContext

.MergeCells = False

End With

Selection.Merge

Module1.CreateTable

Range("A6").Select

ActiveWindow.FreezePanes = True

Range("A5").Name = "Beg" & Worksheets(ActiveSheet.Name).Index

Range("A6").Name = "End" & Worksheets(ActiveSheet.Name).Index

Worksheets(Worksheets.Count).Name = txtNaim

Me.Hide

Range("E1").Select

Selection.Hyperlinks.Add Anchor:=Selection, Address:="http://" & txtSite.Text

Columns("A:J").Select

Selection.ColumnWidth = 15.5

Range("A1").Select

' ActiveSheet.Protect Password:="list", DrawingObjects:=True, Contents:=True, Scenarios:=True, _

AllowFormattingCells:=True, AllowFormattingColumns:=True, AllowFormattingRows:=True

' Workbooks("Firms").Protect Password:="Firms1"

End Sub

Private Sub UserForm_Activate()

Workbooks("Firms").Unprotect Password:="Firms1"

ActiveSheet.Unprotect Password:="list"

lblNaim.ControlTipText = _

"Имя должно быть не более 31 знака. И не содержать символов : / \ ? * [ ]"

txtNaim = ""

txtAdr = ""

txtTel1 = ""

txtTel2 = ""

txtSite = ""

End Sub

//Workbook(“Firms.xls”) Форма SubMain

Private Sub CommandButton11_Click()

Me.Hide

ex = 1

listFirm.Show

If ex = 0 Then Exit Sub

ex = 1

EditFirm

If ex = 0 Then Exit Sub

End Sub

Private Sub CommandButton12_Click()

Me.Hide

ex = 1

listFirm.Show

If ex = 0 Then Exit Sub

ex = 1

EditPut

If ex = 0 Then Exit Sub

End Sub

Private Sub CommandButton14_Click()

Me.Hide

ex = 1

listFirm.Show

If ex = 0 Then Exit Sub

ex = 1

DeleteFirm

If ex = 0 Then Exit Sub

End Sub

Private Sub CommandButton15_Click()

Me.Hide

ex = 1

listFirm.Show

If ex = 0 Then Exit Sub

ex = 1

DeleteCoun

If ex = 0 Then Exit Sub

End Sub

Private Sub CommandButton17_Click()

Dim sav As Integer

If Workbooks("Firms.xls").Saved = False Or Workbooks("Main.xls").Saved = False Then

sav = MsgBox("Сохранить и выйти?", vbYesNo + vbInformation, "Внимание!")

If sav = vbNo Then Exit Sub

If sav = vbYes Then

Workbooks("Firms.xls").Save

Workbooks("Main.xls").Save

Application.Quit

End If

End If

End Sub

Private Sub CommandButton18_Click()

Me.Hide

ShowList

End Sub

Private Sub CommandButton7_Click()

Workbooks("Firms.xls").Save

Workbooks("Main.xls").Save

Application.Quit

End Sub

Private Sub CommandButton8_Click()

Me.Hide

NewFirmLo

End Sub

Private Sub CommandButton9_Click()

Me.Hide

ex = 1

listFirm.Show

If ex = 0 Then Exit Sub

ex = 1

NewPut

If ex = 0 Then Exit Sub

End Sub

Private Sub UserForm_Activate()

Workbooks("Main.xls").Worksheets("1").Activate

Caption = Space(80) & "Меню работы с фирмами" & Space(60)

End Sub

//Workbook(“Firms.xls”) Module1

Public ex As Integer

Option Compare Text

Sub CreateTable()

Range("A5").FormulaR1C1 = "Город"

Range("B5").FormulaR1C1 = "Кол-во своб. мест (взр.)"

Range("C5").FormulaR1C1 = "Цена взр. билета"

Range("D5").FormulaR1C1 = "Кол-во своб. мест (дет.)"

Range("E5").FormulaR1C1 = "Цена дет. билета"

Range("F5").FormulaR1C1 = "Цена страховки"

Range("G5").FormulaR1C1 = "Длительность путевки (дн.)"

Range("H5").FormulaR1C1 = "Отель"

Range("I5").FormulaR1C1 = "Кол-во звезд"

Range("J5").FormulaR1C1 = "Доп. Услуги"

Range("A5:J6").Select

With Selection

.HorizontalAlignment = xlCenter

.VerticalAlignment = xlCenter

.WrapText = True

.Orientation = 0

.AddIndent = False

.IndentLevel = 0

.ShrinkToFit = False

.ReadingOrder = xlContext

.MergeCells = False

End With

With Selection.Font

.Name = "Arial"

.FontStyle = "полужирный"

.Size = 8

.Strikethrough = False

.Superscript = False

.Subscript = False

.OutlineFont = False

.Shadow = False

.Underline = xlUnderlineStyleNone

.ColorIndex = xlAutomatic

End With

Selection.Borders(xlDiagonalDown).LineStyle = xlNone

Selection.Borders(xlDiagonalUp).LineStyle = xlNone

With Selection.Borders(xlEdgeLeft)

.LineStyle = xlContinuous

.Weight = xlMedium

.ColorIndex = xlAutomatic

End With

With Selection.Borders(xlEdgeTop)

.LineStyle = xlContinuous

.Weight = xlMedium

.ColorIndex = xlAutomatic

End With

With Selection.Borders(xlEdgeBottom)

.LineStyle = xlContinuous

.Weight = xlMedium

.ColorIndex = xlAutomatic

End With

With Selection.Borders(xlEdgeRight)

.LineStyle = xlContinuous

.Weight = xlMedium

.ColorIndex = xlAutomatic

End With

With Selection.Borders(xlInsideVertical)

.LineStyle = xlContinuous

.Weight = xlThin

.ColorIndex = xlAutomatic

End With

With Selection.Borders(xlInsideHorizontal)

.LineStyle = xlContinuous

.Weight = xlMedium

.ColorIndex = xlAutomatic

End With

With Selection.Interior

.ColorIndex = 19

.Pattern = xlSolid

.PatternColorIndex = xlAutomatic

End With

End Sub

Sub NewPut()

Workbooks("Firms").Unprotect Password:="Firms1"

ActiveSheet.Unprotect Password:="list"

string1 = "Firms.xls"

If ActiveSheet.Name = "1" Or ActiveWorkbook.Name <> CStr(string1) Then

MsgBox "Выберите (активируйте) лист в книге /Firms/, в который нужно внести изменения.", vbInformation, "Внимание!"

Exit Sub

End If

ex = 1

frmNewPut.Show

' ActiveSheet.Protect Password:="list", DrawingObjects:=True, Contents:=True, Scenarios:=True, _

AllowFormattingCells:=True, AllowFormattingColumns:=True, AllowFormattingRows:=True

' Workbooks("Firms").Protect Password:="Firms1"

If ex = 0 Then Exit Sub

End Sub

Sub EditFirm()

Workbooks("Firms").Unprotect Password:="Firms1"

ActiveSheet.Unprotect Password:="list"

fl = 0

string1 = "Firms.xls"

If ActiveSheet.Name = "1" Or ActiveWorkbook.Name <> CStr(string1) Then

MsgBox "Выберите (активируйте) лист в книге /Firms/, в который нужно внести изменения.", vbInformation, "Внимание!"

Exit Sub

End If

frmEditFirm.txtNaim.Text = ActiveSheet.Range("A1").Value

frmEditFirm.txtAdr.Text = ActiveSheet.Range("B1").Value

frmEditFirm.txtTel1.Text = ActiveSheet.Range("C1").Value

frmEditFirm.txtTel2.Text = ActiveSheet.Range("D1").Value

frmEditFirm.txtSite.Text = ActiveSheet.Range("E1").Value

ex = 1

frmEditFirm.Show

If ex = 0 Then Exit Sub

ActiveSheet.Range("A1").Value = frmEditFirm.txtNaim.Text