Код программы:

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

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Main.Show

End Sub

//Workbook(“Main.xls”). Worksheets(“СписокФирм”)

Private Sub Worksheet_Activate()

'Экспорт

maxi = 5

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, 5)).Delete

Range("A3").Name = "Наим"

a = Range("Наим").Row + 1

n = 0

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

If Sheet.Name <> "1" Then

For j = 1 To 5

If j = 5 Then

Workbooks("Main").Worksheets("СписокФирм").Cells(a, j).Hyperlinks.Add _

Anchor:=Workbooks("Main").Worksheets("СписокФирм").Cells(a, j), _

Address:="http://" & Sheet.Cells(1, j)

Exit For

End If

Workbooks("Main").Worksheets("СписокФирм").Cells(a, j) = _

Sheet.Cells(1, j)

Stri = CStr(Sheet.Name)

If j = 1 Then

ActiveSheet.Hyperlinks.Add Anchor:=Workbooks("Main").Worksheets("СписокФирм").Cells(a, j), _

Address:="C:\Users\Marinkoff\Desktop\Firms.xls", SubAddress:= _

"'" & Stri & "'!A1", TextToDisplay:=CStr(Sheet.Cells(1, j).Value)

End If

Next j

Оформить a, maxi

a = a + 1

n = n + 1

End If

Next Sheet

Label1.Caption = Chr(13) & "В базе данных " & n & " турфирм" & Chr(13)

Columns("A:E").Select

Selection.RowHeight = 30

Selection.ColumnWidth = 24

If ActiveSheet.AutoFilterMode = False Then

Range("A3:E3").Select

Selection.AutoFilter

End If

Range("A1").Select

End Sub

//Workbook(“Main.xls”). Worksheets(“ПоискПутевки”)

Private Sub CommandButton1_Click()

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

End Sub

Private Sub CommandButton2_Click()

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

Private Sub CommandButton3_Click()

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

Main.Show

End Sub

//Workbook(“Main.xls”). Worksheets(“Заказы”)

Private Sub CommandButton1_Click()

Main.Show

End Sub

Private Sub Worksheet_Activate()

Columns("A:P").Select

Selection.ColumnWidth = 8.71

If ActiveSheet.AutoFilterMode = False Then

Range("A3:P3").Select

Selection.AutoFilter

End If

Range("A1").Select

i = 3

Do

i = i + 1

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

Kol_Prstr = 4

Label1.Caption = Chr(13) & "В базе " & i - Kol_Prstr & " заказа (-ов)"

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

i = 3

Do

i = i + 1

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

Kol_Prstr = 4

Label1.Caption = Chr(13) & "В базе " & i - Kol_Prstr & " заказа (-ов)"

End Sub

//Workbook(“Main.xls”). Worksheets(“ВыхФорма”)

Private Sub CommandButton1_Click()

ActiveSheet.PrintOut Preview:=True

End Sub

Private Sub CommandButton2_Click()

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

Main.Show

End Sub

//Workbook(“Main.xls”)

Private Sub Workbook_Open()

' Application.Workbooks.Open "I:\БДТурфирм\Firms.xls"

MenuBars(xlWorksheet).Menus.Add Caption:="&Работа с заказами и путевками", Before:=11

MenuBars(xlWorksheet).Menus("&Работа с заказами и путевками").MenuItems.Add _

Caption:="&Перейти в главное меню", Before:=2, OnAction:="MainS"

MenuBars(xlWorksheet).Menus("&Работа с заказами и путевками").MenuItems.Add _

Caption:="&Новый заказ", Before:=3, OnAction:="NewZa"

MenuBars(xlWorksheet).Menus("&Работа с заказами и путевками").MenuItems.Add _

Caption:="&Редактирование заказа", Before:=4, OnAction:="EditZa"

MenuBars(xlWorksheet).Menus("&Работа с заказами и путевками").MenuItems.Add _

Caption:="&Удаление заказа", Before:=5, OnAction:="DelZa"

MenuBars(xlWorksheet).Menus("&Работа с заказами и путевками").MenuItems.Add _

Caption:="&Поиск путевки по определенным критериям", Before:=6, OnAction:="ShowPut"

Worksheets("1").Activate

Main.Show

End Sub

//Workbook(“Main.xls”) Форма Find

Option Compare Text

Private Sub CheckBox1_Change()

If CheckBox1.Value = True Then

ComboBox1.Enabled = True

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

If Sheet.Name <> "1" Then

ComboBox1.AddItem Sheet.Name

End If

Next Sheet

Else

ComboBox1.Enabled = False

ComboBox1.Clear

ComboBox2.Clear

ComboBox3.Clear

CheckBox2.Value = False

ComboBox2.Enabled = False

CheckBox3.Value = False

ComboBox3.Enabled = False

ComboBox2.Clear

Exit Sub

End If

End Sub

Private Sub CheckBox2_Change()

If CheckBox2.Value = True Then

ComboBox2.Enabled = True

CheckBox3.Value = True

ComboBox3.Enabled = True

End If

If CheckBox2.Value = True And CheckBox1.Value = False Then

ComboBox2.Enabled = True

CheckBox3.Value = True

ComboBox3.Enabled = True

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

If Sheet.Name <> "1" Then

num = Workbooks("Firms").Worksheets(Sheet.Name).Index

ie = Workbooks("Firms").Worksheets(Sheet.Name).Range("End" & num).Row

With Workbooks("Firms").Worksheets(Sheet.Name)

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

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

If ComboBox2.ListCount = 0 Then

ComboBox2.AddItem .Cells(ib, 1).Value

Else

flaf = 0

For k = 0 To ComboBox2.ListCount - 1

If ComboBox2.List(k) = .Cells(ib, 1).Value Then

flaf = 1

Exit For

Else

flaf = 0

End If

Next k

If flaf = 0 Then

ComboBox2.AddItem .Cells(ib, 1).Value

End If

End If

End If

Next ib

End With

End If

Next Sheet

End If

If CheckBox2.Value = False Then

ComboBox2.Enabled = False

CheckBox3.Value = False

ComboBox3.Enabled = False

ComboBox2.Clear

Exit Sub

End If

End Sub

Private Sub CheckBox4_Change()

If CheckBox4.Value = True Then

TextBox2.Enabled = True

TextBox3.Enabled = True

TextBox4.Enabled = True

TextBox5.Enabled = True

Else

TextBox2.Text = ""

TextBox3.Text = ""

TextBox4.Text = ""

TextBox5.Text = ""

TextBox2.Enabled = False

TextBox3.Enabled = False

TextBox4.Enabled = False

TextBox5.Enabled = False

End If

End Sub

Private Sub ComboBox1_Change()

ComboBox2.Clear

ComboBox3.Clear

If ComboBox1.Value <> "" Then

num = Workbooks("Firms").Worksheets(ComboBox1.Value).Index

ie = Workbooks("Firms").Worksheets(ComboBox1.Value).Range("End" & num).Row

With Workbooks("Firms").Worksheets(ComboBox1.Value)

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 With

End If

End Sub

Private Sub ComboBox2_Change()

ComboBox3.Clear

If ComboBox1.Value <> "" Then

k = 0

num = Workbooks("Firms.xls").Worksheets(ComboBox1.Value).Index

ie = Workbooks("Firms.xls").Worksheets(ComboBox1.Value).Range("End" & num).Row

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

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

If ComboBox2.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

ComboBox3.AddItem .Cells(k, 1).Value

k = k + 1

Loop

End With

Else

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

flagnet = 0

If Sheet.Name <> "1" Then

k = 0

num = Workbooks("Firms.xls").Worksheets(Sheet.Name).Index

ie = Workbooks("Firms.xls").Worksheets(Sheet.Name).Range("End" & num).Row

If ie <> 6 Then

With Workbooks("Firms.xls").Worksheets(Sheet.Name)

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

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

flagnet = 1

k = .Cells(ib, 1).Row

Exit For

End If

Next ib

If flagnet = 1 Then

k = k + 1

temp = k

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

If ComboBox3.ListCount = 0 Then

ComboBox3.AddItem .Cells(k, 1).Value

k = k + 1

Else

flaf = 0

For p = 0 To ComboBox3.ListCount - 1

If ComboBox3.List(p) = .Cells(k, 1).Value Then

flaf = 1

Exit For

Else

flaf = 0

End If

Next p

If flaf = 0 Then

ComboBox3.AddItem .Cells(k, 1).Value

k = k + 1

Else

k = k + 1

End If

End If

Loop

End If

End With

End If

End If

Next Sheet

End If

End Sub

Private Sub CommandButton1_Click()

flag = 0

flag2 = 0

maxi = 12

k = 0

i = 4

'если ничего не выбрано

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

And ComboBox3.Value = "" And TextBox2.Text = "" _

And TextBox3.Text = "" And TextBox4.Text = "" _

And TextBox5.Text = "" Then

MsgBox "Выберите необходимые критерии для поиска.", vbCritical, "Ошибка!"

Exit Sub

End If

'если выбрана только фирма

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

And ComboBox3.Value = "" And TextBox2.Text = "" _

And TextBox3.Text = "" And TextBox4.Text = "" _

And TextBox5.Text = "" Then

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

Me.Hide

End If

'если выбрана только страна

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

And ComboBox3.Value = "" And TextBox2.Text = "" _

And TextBox3.Text = "" And TextBox4.Text = "" _

And TextBox5.Text = "" Then

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

k = 0

If Sheet.Name <> "1" Then

num = Workbooks("Firms.xls").Worksheets(Sheet.Name).Index

ie = Workbooks("Firms.xls").Worksheets(Sheet.Name).Range("End" & num).Row

If ie <> 6 Then

With Workbooks("Firms.xls").Worksheets(Sheet.Name)

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

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

k = .Cells(ib, 1).Row

Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 1).Value = Sheet.Name

Stri = CStr(Sheet.Name)

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

Anchor:=Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 1), _

Address:="C:\Users\Marinkoff\Desktop\Firms.xls", SubAddress:= _

"'" & Stri & "'!A1", TextToDisplay:=CStr(Sheet.Name)

Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 2).Value = CStr(ComboBox2.Value)

Оформить i, maxi

i = i + 1

End If

Next ib

End With

End If

End If

Next Sheet

Me.Hide

End If

'если выбрана фирма и страна

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

And ComboBox3.Value = "" And TextBox2.Text = "" _

And TextBox3.Text = "" And TextBox4.Text = "" _

And TextBox5.Text = "" Then

num = Workbooks("Firms.xls").Worksheets(ComboBox1.Value).Index

ie = Workbooks("Firms.xls").Worksheets(ComboBox1.Value).Range("End" & num).Row

If ie <> 6 Then

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

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

If ComboBox2.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

For ib = k To ie

If .Cells(ib, 1).MergeCells = False And ib <> ie Then

Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 1).Value = ComboBox1.Value

Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 2).Value = ComboBox2.Value

Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 3).Value = .Cells(ib, 1).Value

Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 4).Value = .Cells(ib, 2).Value

Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 5).Value = .Cells(ib, 3).Value

Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 6).Value = .Cells(ib, 4).Value

Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 7).Value = .Cells(ib, 5).Value

Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 8).Value = .Cells(ib, 6).Value

Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 9).Value = .Cells(ib, 7).Value

Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 10).Value = .Cells(ib, 8).Value

Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 11).Value = .Cells(ib, 9).Value

Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 12).Value = .Cells(ib, 10).Value

Оформить i, maxi

i = i + 1

Else

Exit For

End If

Next ib

End With

End If

Me.Hide

End If

'если выбрана фирма и цена

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

And ComboBox3.Value = "" And TextBox2.Text <> "" _

And TextBox3.Text <> "" Or TextBox4.Text <> "" _

And TextBox5.Text <> "" Then

num = Workbooks("Firms.xls").Worksheets(ComboBox1.Value).Index

ie = Workbooks("Firms.xls").Worksheets(ComboBox1.Value).Range("End" & num).Row

If ie <> 6 Then

If TextBox2.Text <> "" And TextBox3.Text <> "" Then

If IsNumeric(TextBox3.Text) = True And IsNumeric(TextBox2.Text) = True Then

If CDbl(TextBox3.Text) > CDbl(TextBox2.Text) Then

flag = 1

Else

MsgBox "Проверьте введенные данные в поле Цена.", vbCritical, "Ошибка!"

Exit Sub

End If

Else

MsgBox "Поля От и До должны быть заполнены числами.", vbCritical, "Ошибка!"

Exit Sub

End If

End If

If TextBox4.Text <> "" And TextBox5.Text <> "" Then

If IsNumeric(TextBox4.Text) = True And IsNumeric(TextBox5.Text) = True Then

If CDbl(TextBox5.Text) > CDbl(TextBox4.Text) Then

flag2 = 1

Else

MsgBox "Проверьте введенные данные в поле Цена.", vbCritical, "Ошибка!"

Exit Sub

End If

Else

MsgBox "Поля От и До должны быть заполнены числами.", vbCritical, "Ошибка!"

Exit Sub

End If

End If

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

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

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

k = .Cells(ib, 1).Row

For beg = k + 1 To ie

If .Cells(beg, 1).MergeCells = False And beg <> ie Then

If flag = 1 And flag2 = 0 Then

If .Cells(beg, 3).Value >= CDbl(TextBox2.Text) _

And .Cells(beg, 3).Value <= CDbl(TextBox3.Text) Then

Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 1).Value = ComboBox1.Value

Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 2).Value = .Cells(k, 1).Value

Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 3).Value = .Cells(beg, 1).Value

Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 4).Value = .Cells(beg, 2).Value

Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 5).Value = .Cells(beg, 3).Value

Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 6).Value = .Cells(beg, 4).Value

Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 7).Value = .Cells(beg, 5).Value

Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 8).Value = .Cells(beg, 6).Value

Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 9).Value = .Cells(beg, 7).Value

Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 10).Value = .Cells(beg, 8).Value

Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 11).Value = .Cells(beg, 9).Value

Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 12).Value = .Cells(beg, 10).Value

Оформить i, maxi

i = i + 1

End If

End If

If flag2 = 1 And flag = 0 Then

If .Cells(beg, 5).Value >= CDbl(TextBox4.Text) _

And .Cells(beg, 5).Value <= CDbl(TextBox5.Text) Then

Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 1).Value = ComboBox1.Value

Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 2).Value = .Cells(k, 1).Value

Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 3).Value = .Cells(beg, 1).Value

Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 4).Value = .Cells(beg, 2).Value

Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 5).Value = .Cells(beg, 3).Value

Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 6).Value = .Cells(beg, 4).Value

Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 7).Value = .Cells(beg, 5).Value

Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 8).Value = .Cells(beg, 6).Value

Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 9).Value = .Cells(beg, 7).Value

Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 10).Value = .Cells(beg, 8).Value

Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 11).Value = .Cells(beg, 9).Value

Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 12).Value = .Cells(beg, 10).Value

Оформить i, maxi

i = i + 1

End If

End If

If flag2 = 1 And flag = 1 Then

If .Cells(beg, 5).Value >= CDbl(TextBox4.Text) And _

.Cells(beg, 5).Value <= CDbl(TextBox5.Text) And _

.Cells(beg, 3).Value >= CDbl(TextBox2.Text) And _

.Cells(beg, 3).Value <= CDbl(TextBox3.Text) Then

Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 1).Value = ComboBox1.Value

Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 2).Value = .Cells(k, 1).Value

Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 3).Value = .Cells(beg, 1).Value

Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 4).Value = .Cells(beg, 2).Value

Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 5).Value = .Cells(beg, 3).Value

Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 6).Value = .Cells(beg, 4).Value

Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 7).Value = .Cells(beg, 5).Value

Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 8).Value = .Cells(beg, 6).Value

Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 9).Value = .Cells(beg, 7).Value