Разработка базы данных 'Туризм и отдых'

  • Вид работы:
    Курсовая работа (т)
  • Предмет:
    Информационное обеспечение, программирование
  • Язык:
    Русский
    ,
    Формат файла:
    MS Word
    1,94 Мб
  • Опубликовано:
    2013-01-17
Вы можете узнать стоимость помощи в написании студенческой работы.
Помощь в написании работы, которую точно примут!

Разработка базы данных 'Туризм и отдых'

Министерство образования Нижегородской области

Государственное бюджетное образовательное учреждение

Среднего профессионального образования

"Нижегородский экономико-правовой колледж им. Б.П. Трифонова"

Цикловая комиссия спецдисциплин программирования





КУРСОВАЯ РАБОТА

РАЗРАБОТКА БАЗЫ ДАННЫХ

"ТУРИЗМ И ОТДЫХ"

по дисциплине

"Технология разработки программных продуктов"



Студент: М.О. Чиркова12.12.2011

Специальность, группа: 230105, 41П






Нижний Новгород 2011

Содержание

 

Введение

Глава 1. Общая часть

1.1 Тенденция развития информационных систем и информационных технологий

1.2 Содержательная постановка задачи

Глава 2. Основы проектирования структуры информационной системы

2.1 Проектирование базы данных

2.2 Концептуальная модель базы данных

Глава 3. Разработка и содержание системы

3.1 Основные задачи, реализованные в системе

3.2 Информационная модель автоматизированного решения задачи

3.3 Технология решения задачи

Литература

Приложение

Введение

Кажется, еще совсем недавно, но уверенным шагом вошли в нашу жизнь персональные компьютеры. Еще совсем недавно их считали как элитную вещь, доступную не каждому. Но минует время, техника стремительно совершенствуется, и уже каждая десятая семья имеет персональный компьютер. Для взрослых членов семьи он стал незаменимым помощником, нужным для работы, а для детей - преимущественно источником развлечений.

Быстрое усовершенствование технических данных компьютеров постоянно расширяет его возможности. Если раньше круг использования персонального компьютера был немного ограниченным, то сегодня тяжело найти область или род профессиональной деятельности человека, в котором бы не использовали компьютерных технологий.

Современные ПК - это возможность создания огромных по объему банков данных (в частности, в Интернете), быстрый поиск и распечатывание информации, набор и тиражирование текстов, бланков и т.п., осуществление расчетов в банковском и бухгалтерском делах, психическая и медицинская индивидуальная диагностика, обработка и вывод на экран дисплея или печать ее результатов, моделирование одежды, дизайна мебели, планирование квартир и офисов, создание рисованных кадров в мультипликации, рекламных роликов, фотороботов в криминалистике, программное управление машинами, кораблями, космическими спутниками. И этот список далеко не весь…

Большинство современных предприятий широко используют компьютерные технологии. Это связано в основном с необходимостью различных организаций получать, обрабатывать и хранить большие объёмы информации. Для централизованного и упорядоченного хранения данных используются базы данных.

база информационная система менеджер

База данных - представленная в таким образом, чтобы эти материалы могли быть

Для чего нужны базы данных?

В современном мире практически невозможно представить компанию (фирму, организацию), в которой не требуется обработка некоторого объёма информации. Информацию требуется где-то хранить, она может динамически изменяться. Также регулярно требуется выборка данных по определенным критериям из всего массива данных.

При автоматизации бизнес-процессов часто возникают задачи, которые не решают уже готовые программы и базы данных. При этом аналитическая информация показывает, что даже если использовать сложные и дорогостоящие CRM-системы (Customer Relationship Management - система управления взаимоотношениями с клиентами) управления предприятием, получить решение, удовлетворяющее руководство компании, бывает просто невозможно.

Базы данных создаются специально для хранения, обработки, проведения расчетов, сортировки, выборки и представления любых массивов данных по любым критериям.

Мое задание курсового проекта состояло в том, чтобы разработать базу данных "Туризм и Отдых", которая должна частично автоматизировать работу менеджера по туризму в туристическом агентстве.

Курсовой проект содержит следующие разделы:

·        Введение, где отражен современный уровень развития вычислительной техники, программного обеспечения, средств автоматизации. Во введении определяются цели и задачи курсового проекта, а также краткое содержание курсового проекта в целом.

·        Общая часть, где описывается тенденция развития информационных систем и информационных технологий, а также дается Содержательная постановка задачи курсового проекта.

·        Основы проектирования структуры информационной системы. Этот раздел состоит из 2 подразделов: проектирование базы данных (описание всего технологического процесса разработки курсового проекта, начиная с этапа постановки задачи и заканчивая этапом получения результатов), концептуальная модель базы данных.

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

·        Приложение. В этом разделе приводится исходный код программы.

Глава 1. Общая часть


1.1 Тенденция развития информационных систем и информационных технологий


Информационная система - это взаимосвязанная совокупность средств, методов и персонала, используемых для хранения, обработки и выдачи информации в интересах достижения поставленной цели.

Этапы развития информационных систем и цели их использования представлены в таблице:

Период времени

Концепция использования информации

Вид информационной системы - ИС

Цель использования ИС

1950 - 1960 гг.

Бумажный поток расчетных документов

ИТ обработки расчетных документов на электромеханических бухгалтерских машинах

Повышение скорости обработки документов. Упрощение процедуры обработки счетов и расчета зарплаты

1960 - 1970 гг.

Основная помощь в подготовке отчетов

Управленческие ИТ для производственной информации

Ускорение процесса подготовки отчетности

1970 1980 гг.

Управленческий контроль реализации (продаж)

Системы поддержки принятия решений. Системы для высшего звена управления.

Выработка наиболее рационального решения

1980 - 2000 гг.

Информация - стратегический ресурс, обеспечивающий конкурентное преимущество

Стратегические ИТ. Автоматизированные подразделения

Повышение конкурентоспособности предприятия


Первые информационные системы появились в 50х годах. Они были предназначены для обработки счетов и расчета зарплаты, а реализовывались на электромеханических бухгалтерских счетных машинах. Это приводило к некоторому сокращению затрат и времени на подготовку бумажных документов.

-е годы знаменуются изменением отношения к информационным системам. Информация, полученная из них, стала применяться для периодической отчетности по многим параметрам. Для этого организациям требовалось компьютерное оборудование широкого назначения, способное обслуживать множество функций, а не только обрабатывать счета и считать зарплату.

В 70-х - начале 80-х годов информационные системы начинают широко использоваться в качестве средства управленческого контроля, поддерживающего и ускоряющего процесс принятия решений.

К концу 80-х годов концепция использования информационных систем вновь изменяется. Они становятся стратегическим источником информации и используются на всех уровнях организации любого профиля. Информационные системы этого периода, предоставляя вовремя нужную информацию, помогают организации достичь успеха в своей деятельности, создавать новые товары и услуги, находить новые рынки сбыта, обеспечивать себе достойных партнеров, организовывать выпуск продукции по низкой цене и много другое

Информационные технологии (ИТ, Information Technology, IT) - это класс областей деятельности, относящихся к технологиям управления и обработкой огромного потока информации с применением вычислительной техники.

Существует несколько точек зрения на развитие информационных технологий с использованием компьютеров, которые определяются различными признаками деления.

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

Выделяют несколько признаков, по которым можно классифицировать информационные системы.

Основные признаки деления информационных технологий:

.        Классификация ИС по признаку структурированности задач.

ü Создающие управленческие отчеты и ориентированные главным образом на обработку данных (поиск, сортировку, агрегирование, фильтрацию). Менеджер принимает решение, опираясь на сведения, содержащиеся этих отчетах;

ü Разрабатывающие возможные альтернативы решения. Принятие решения менеджером при этом сводится к выбору одной из предложенных ему альтернатив. Информационные системы, разрабатывающие альтернативы решений, могут быть модельными и экспертными.

2.      Классификация ИС по степени автоматизации.

ü ручные ИС - характеризуются полным отсутствием современных технических средств обработки информации и выполнением всех операций человеком;

ü автоматические ИС - выполняют все операции по переработке информации без участия человека;

ü автоматизированные ИС - предполагают участие в процессе обработки информации и человека, и технических средств, причем главная роль отводится компьютеру. В современном толковании в термин "информационная система" вкладывается понятие автоматизированной системы.

3.      Классификация ИС по характеру использования информации.

ü Информационно-поисковые системы производят ввод, систематизацию, хранение, выдачу информации по запросу пользователя без сложных преобразований данных, например ИПС в библиотеке, в железнодорожных и авиа-кассах продажи билетов.

ü Информационно-решающие системы осуществляют операции переработки информации по определенному алгоритму. Среди них можно провести классификацию по степени воздействия выработанной результатной информации на процесс принятия решений и выделить два класса: управляющие и советующие.

4.      Классификация ИС по сфере их применения.

ü ИС организационного управления предназначены для автоматизации функций управленческого персонала. Учитывая высокую распространенность и разнообразие этого класса систем, часто термин "информационные системы" получает именно такое толкование. К этому классу относятся ИС управления как промышленными организациями, так непромышленными объектами: гостиницами, банками, торговыми фирмами и др.

ü ИС управления технологическими процессами служат для автоматизации функций производственного персонала. Они широко используются при организации производства для поддержания технологического процесса в металлургической и машиностроительной промышленности.

ü ИС автоматизированного проектирования предназначены для автоматизации функций инженеров-проектировщиков, конструкторов, архитекторов, дизайнеров при создании новой техники или технологии. Основными функциями САПР являются: инженерные расчеты, создание графической (чертежей, схем, планов) и проектной документации, моделирование проектируемых объектов.

ü Интегрированные (корпоративные) ИС используются для автоматизации большинства функций компаний и охватывают весь цикл работ - от проектирования до сбыта продукции. Создание таких систем весьма затруднительно, поскольку требует системного подхода с позиций главной цели, например получения прибыли, завоевания рынка сбыта и т.д. Такой подход может привести к существенным изменениям в самой структуре компании, на что может решиться не каждый менеджер.

 

.2 Содержательная постановка задачи


Задача данного курсового проекта - разработать базу данных "Туризм и Отдых", которая должна обеспечивать ведение организации отдыха и туризма. Ежегодно большое количество людей обращаются в такие фирмы для обеспечения собственного отдыха, в основном на время отпусков.

База данных должна содержать информацию о туристических фирмах-партнерах (наименование, адрес, контактные телефоны, адрес сайта, информацию о путевках (страна, город, количество свободных мест взрослых и детских, цены на детские и взрослые путевки, цена страховки, длительность путевки, название отеля, в котором будут проживать клиенты, количество звезд отеля, дополнительные услуги)). Также в базе данных должна содержаться информация о клиентах (фамилия, имя, отчество, пол, дата рождения, контактный телефон, email, наименование фирмы, с которой клиент заключил договор, направление тура (страна, город), данные паспорта, оплачена ли путевка, сданы ли заказчиком фотографии, количество приобретенных путевок (взрослых, детских), стоимость путевки).

База данных "Туризм и Отдых" должна автоматизировать основную работу менеджера по туризму, которая заключается в сборе, обработке и хранении информации о клиентах туристических фирм-партнеров, расчете цен на предоставляемые услуги и обеспечении надежного отдыха. База должна содержать реестр зарегистрированных клиентов в удобочитаемой форме, возможность добавлять новых клиентов, редактировать данные о них, осуществлять поиск клиентов, а также формировать отчетность и печать зарегистрированных клиентов. Все эти возможности должны быть реализованы и в реестре зарегистрированных фирм.

Глава 2. Основы проектирования структуры информационной системы


2.1 Проектирование базы данных


Для разработки базы данных "Туризм и Отдых" нужно определить всю необходимую входную и выходную информацию, составить граф-схему, концептуальную модель базы данных, затем написать исходный код программы на встроенном в MS Excel языке программирования VBA (Visual Basic for Application).

MS Visual Basic - средство разработки программного обеспечения, разработанное корпорацией Microsoft, включающее язык программирования и среду разработки приложений.

VBA - немного упрощенная реализация языка программирования Visual Basic, встроенная в линейку продуктов Microsoft Office (включая версии для MAC OS), а также во многие другие программные пакеты, такие как Ошибка! Источник ссылки не найден., Ошибка! Источник ссылки не найден., Ошибка! Источник ссылки не найден., Ошибка! Источник ссылки не найден. и Ошибка! Источник ссылки не найден.. VBA - это легкий способ разработки собственных программ для Windows, передовая и высокоэффективная система разработки приложений Windows, требующая минимум средств и усилий. Созданные на VBA приложения и компоненты можно компилировать с помощью оптимизирующего компилятора, ядро которого идентично применяемому в языке программирования Microsoft C. VBA предоставляет команды для создания и управления необходимыми элементами программы в Windows: диалогами, окнами, линейками меню, раскрывающимися списками, командными списками, панелями инструментов и многие другие. С помощью Visual Basic for Application (VBA) можно легко и быстро создавать пользовательские приложения, используя единую для всех офисных программ среду и язык. Научившись разрабатывать приложения для одной офисной программы, например Excel, можно создавать приложения и для других офисных программ, например Access. VBA обладает мощными встроенными интеллектуальными средствами, которые позволяют даже начинающему пользователя быстро самостоятельно разрабатывать профессиональные приложения. Например, при написании кода программы редактор VBA сам предлагает пользователю возможные продолжения составляемых им инструкций. Другим примером встроенных интеллектуальных средств VBA является макрорекордер, который переводит все выполняемые вручную пользователем действия в основном приложении на язык VBA. Таким образом, макрорекордер позволяет пользователю поручать VBA, самому создавать большие куски кода разрабатываемого приложения. Макропрограммы VBA сохраняются в файловом формате, используемом приложением, в котором написан макрос VBA, а не в отдельных текстовых файлах. Для выполнения макропрограмм VBA ее надо сначала запустить, используя только то приложение, в котором написан этот макрос. Несмотря на то, что основные возможности VBA остаются теми же во всех приложениях Office, каждое приложение добавляет специальные команды и объекты (в зависимости от конкретного приложения) в Visual Basic for Applications. Например, VBA в Word содержит команды, относящиеся только к операциям над текстом в документе, тогда как VBA в Access содержит команды, относящиеся только к операциям с БД, и т.д. В частности, VBA включает необходимые команды для использования Object Linking and Embedding (OLE) и Dynamic Data Exchange (DDE) для связи или совместного использования данных с другими приложениями Windows. Таким образом, с помощью VBA можно создавать приложения практически для любой области современных компьютерных технологий: бизнес-приложений, игры, мультимедиа, базы данных.

База данных "Туризм и Отдых" содержит в себе информацию о фирмах, предоставляющих путевки и о клиентах, заключивших договор с определенной фирмой. Она осуществляет хранение, добавление, редактирование, удаление и поиск этой информации. Для достижения этих целей создаются две рабочие книги (первая - Firms, содержит информацию о туристических фирмах, вторая - Main, содержит информацию о клиентах). Первая книга (Firms) состоит из нескольких листов: первый лист - стартовая работа с базой, остальные листы содержат детальную информацию о каждой из фирм и услуги, которая фирма может предложить клиенту.

Вторая книга (Main) состоит из:

1.      Стартовая страница работы с базой данных;

2.      Страница ("СписокФирм"), содержащая список зарегистрированных туристических фирм;

.        Страницы ("ПоискПутевки"), с помощью которой можно осуществить поиск необходимой путевки по определенным критериям;

.        Страницы "Заказы", где непосредственно можно осуществить заказ путевки;

.        Страницы "Выходная форма", где по запросу пользователя выводится информация о конкретном заказе.

Для работы с данными создаётся ряд форм, два горизонтальных меню, облегчающих работу с базой данных, а также дополнительные таблицы для организации расширенного поиска. Созданные формы должны наглядно отображать весь необходимый диалог с пользователем.

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

2.2 Концептуальная модель базы данных


Цель концептуального программирования - создание концептуальной модели данных на основе представлений о предметной области каждого отдельного типа пользователей. Концептуальная модель представляет собой описание основных сущностей (таблиц) и связей между ними без учёта принятой модели базы данных и синтаксиса целевой СУБД. Часто на такой модели отображаются только имена сущностей (таблиц) без указания их атрибутов. Представление пользователя включает в себя данные, необходимые конкретному пользователю для принятия решений или выполнения некоторого задания.

База данных "Туризм и Отдых" состоит из двух рабочих книг (первая содержит информацию о туристических фирмах, вторая содержит информацию о клиентах), связанных между собой, каждая из которых содержит свои формы для просмотра, добавления, редактирования, поиска и вид выходного отчёта.

Первая книга (Firms) состоит из нескольких листов: первый лист - стартовая работа с базой, остальные содержат детальную информацию о каждой из фирм и услуги, которая конкретная фирма может предложить клиенту.

На остальных страницах содержатся такие данные, как: наименование фирмы, адрес местонахождения, контактные телефоны, адрес сайта фирмы и информацию о путевках (Страна, Город, Количество свободных мест взрослых и детских, Цена взрослого и детского билетов, Цена страховки, Длительность путевки, Название отеля, в котором будет проживать клиент, Количество звезд отеля, Дополнительные услуги).

Вторая книга (Main) состоит из: рабочего листа "1" - стартовая работа с базой данных, листа "СписокФирм", содержащего список зарегистрированных туристических фирм (синхронизация с книгой Firms) и краткую информацию о них (Наименование фирмы, Адрес, Контактные телефоны, Адрес сайта фирмы), листа "ПоискПутевки", с помощью которого можно осуществить поиск необходимой путевки по определенным критериям (Фирма, Страна, Город, Цена путевки), листа "Заказы", где непосредственно можно осуществить заказ путевки и листа "Выходная форма", где по запросу пользователя выводится информация о конкретном заказе.

Рис.1. Схема данных со связями

Глава 3. Разработка и содержание системы


3.1 Основные задачи, реализованные в системе


Разработанная база данных "Туризм и Отдых" содержит всю необходимую менеджеру по туризму информацию о клиентах и о туристических фирмах-партнерах, предоставляющих свои услуги по организации отдыха клиентов.

Работнику предоставлена возможность удобной организации учета клиентов и туристических фирм-партнеров с минимальными временными затратами.

С помощью разработанной базы данных её пользователю предоставляются возможности просмотра имеющейся информации, добавления новой информации с помощью специальных форм, редактирование уже имеющейся информации, удаление данных, организации поиска необходимых путевок по некоторым критериям и уже имеющихся заказов в базе данных.

Готовая программа протестирована и отвечает всем требованиям, предъявленным заказчиком.

3.2 Информационная модель автоматизированного решения задачи


На начальном этапе разработки базы данных "Туризм и Отдых" была создана форма Main (Рис.2), которая представляет собой главное меню программы.

При нажатии кнопки "Перейти в книгу Firms" на экране появится рабочая книга Firms, в которой можно указать подробную информацию о фирмах и услугах, которые фирмы смогут предоставить клиенту.

При нажатии на кнопку "Перейти к списку фирм" на экране появится рабочий лист рабочей книги Main "СписокФирм", в котором будет отображаться список всех фирм, зарегистрированных в книге Firms.

При нажатии кнопки "Перейти к списку заказов" на экране отобразится рабочий лист "Заказы" рабочей книги Main, где будет находиться информация о клиентах, заказавших путевки.

При нажатии на кнопки "Сделать новый заказ", "Редактировать данные заказа", "Удалить заказ из базы" на экране отобразится рабочий лист "Заказы" книги Main после чего предоставляется возможность соответственно внести новый заказ в базу - на экране отобразится форма frmNewZakaz (Рис.3), на форме имеются кнопки "Сохранить в базе" и "Сохранить в базе и создать выходную форму" (при нажатии на нее информация о заказе будет сохранена в базе и выведена на лист "ВыхФорма"); редактировать уже существующий заказ - отобразится окно с сообщением какой заказ необходимо изменить (Рис.4), после ввода номера заказа отобразится форма frmNewZakaz с текущей информацией о заказе, нажав на кнопку "Сохранить в базе" или "Сохранить в базе и создать выходную форму" в базу будут внесены изменения; удалить заказ из базы - отобразится окно с сообщением, какой заказ необходимо удалить из базы, после чего заказ с определенным номером будет удален из базы.

При нажатии на кнопку "Поиск путевки по критериям" программа перейдет к рабочему листу "ПоискПутевки" и на экране отобразится форма Find (Рис.5), после выбора критериев поиска и их подтверждения на листе "ПоискПутевки" отобразятся результаты поиска.

При нажатии кнопки "Сохранить все данные и выйти" произойдет сохранение всех данных в рабочих книгах Firms и Main, после чего приложение MS Excel закроется.

Также была создана форма SubMain, которая представляет собой меню работы с рабочей книгой Firms (Рис.6).

При нажатии на кнопку "Перейти на определенную фирму" появится форма listFirm (Рис.7), в которой можно выбрать определенную фирму, после нажатия кнопки ОК программа перейдет на лист выбранной из списка фирмы.

При нажатии на кнопку "Добавить новую фирму в базу" на экране отобразится форма NewFirmLo (Рис.8), после ввода необходимых данных будет создан новый рабочий лист с именем, указанным в поле Наименование формы NewFirmLo.

При нажатии на кнопку "Редактировать данные фирмы" отобразится форма frmEditFirm (Рис.9), позволяющей изменить информацию об определенной фирме, после подтверждения ввода новых данных данные о фирме будут изменены.

При нажатии на кнопку "Удалить фирму из базы" будет отображена форма listFirm, после чего появится окно с сообщением о подтверждении удаления фирмы из базы (Рис.10), если удаление подтверждено пользователем, фирма и все ее данные будут удалены из базы.

При нажатии на кнопку "Добавить новую путевку" на экране появится форма listFirm. Далее будет отображена форма frmNewPut (Рис.11), в которой есть две возможности (добавить путевку /новая страна и город/ и добавить путевку /новый город в уже существующей стране/), после ввода необходимых данных и подтверждения ввода появится форма frmPInfo (Рис.12), в которой указываются подробные данные о путевке, после чего на листе определенной фирмы будут внесены соответствующие изменения.

При нажатии на кнопку "Редактировать данные путевки" появится форма listFirm, далее форма frmSelPut (Рис.13), в которой предлагается выбрать страну и город путевки, которые необходимо изменить, введя и подтвердив данные в форме frmSelPut, на экране отобразится форма frmPInfo. После ввода новых данных о путевке и подтверждения изменения данных, информация о путевке определенной фирмы будет изменена.

При нажатии на кнопку "Удалить путевку из базы" появится форма listFirm, после нее форма frmDelCoun (Рис.14), в которой предлагается выбрать страну и все ее города, либо определенный город страны путевок, которые необходимо удалить, подтвердив удаление, информация об определенной путевке будет удалена из базы.

Рис. 2

Рис. 3

Рис.4

Рис. 5

Рис. 6

Рис. 7

Рис. 8

Рис. 9

Рис. 10

Рис.11

Рис. 12

Рис.13

Рис. 14

3.3 Технология решения задачи


Рис.15 Граф-схема базы данных "Туризм и Отдых".

Рис.15.1 Граф-схема базы данных "Туризм и Отдых". Продолжение.

Литература


1.      А.Ю. Гарнаев "Самоучитель VBA", Технология создания пользовательских приложений, С. - П. BHV, 1999.

2.      В.Г. Кузьменко "VBA 2000" (самоучитель) М., ЗАО "Издательство Бином", 2000.

Приложение


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

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

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

   Main.ShowSub

//Workbook(“Main.xls”). Worksheets(“СписокФирм”)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").SelectSub

//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)).DeleteSubSub 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.ShowSubSub CommandButton3_Click()

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

   Main.ShowSub

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

Private Sub CommandButton1_Click()

   Main.ShowSubSub 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 & " заказа (-ов)"SubSub 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 & " заказа (-ов)"Sub

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

Private Sub CommandButton1_Click()

   ActiveSheet.PrintOut Preview:=TrueSubSub CommandButton2_Click()

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

   Main.ShowSub

//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.ShowSub

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

Compare TextSub 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 IfSubSub 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 IfSubSub 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

       TextBox5.Enabled = False

   End IfSubSub 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 IfSubSub 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 IfSubSub 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

                                       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

                           Else

                               Exit For

                           End If

                       Next beg

                   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 = "" 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 And _

                   ComboBox3.Value = CStr(.Cells(ib, 1).Value) 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

                   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

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

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

                   Else

                       Exit For

                   End If

               Next beg

           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

       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

                   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(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

                               Exit For

                           End If

                       Next ib

                       For beg = k + 1 To ie

                           If ComboBox3.Value = CStr(.Cells(beg, 1).Value) And .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 = Sheet.Name

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

                                       Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 3).Value = ComboBox3.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

                                       Exit For

                                   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 = Sheet.Name

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

                                       Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 3).Value = ComboBox3.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

                                       Exit For

                                   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 = Sheet.Name

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

                                       Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 3).Value = ComboBox3.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

                                       Exit For

                                   End If

                               End If

                           End If

                       Next beg

                   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

        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

                               Exit For

                           End If

                       Next ib

                       k = k + 1

                       For ib = k To ie

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

                           ComboBox3.Value = CStr(.Cells(ib, 1).Value) Then

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

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

                               Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 3).Value = ComboBox3.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

                               Exit For

                           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 <> "" Or 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

                   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(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

                               Exit For

                           End If

                       Next ib

                       k = k + 1

                       For ib = k To ie

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

                               If flag = 1 And flag2 = 0 Then

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

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

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

                                       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

                                   End If

                               End If

                               If flag2 = 1 And flag = 0 Then

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

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

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

                                       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

                                   End If

                               End If

                               If flag2 = 1 And flag = 1 Then

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

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

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

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

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

                                       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

                                   End If

                               End If

                           Else

                               Exit For

                       Next ib

                   End With

               End If

           End If

       Next Sheet

       Me.Hide

   End IfSubSub UserForm_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

   CheckBox1.Value = False

   CheckBox2.Value = False

   CheckBox3.Value = False

   CheckBox4.Value = False

   ComboBox1.Clear

   ComboBox2.Clear

   ComboBox3.Clear

   TextBox2.Text = ""

   TextBox3.Text = ""

   ComboBox1.Enabled = False

   ComboBox2.Enabled = False

   ComboBox3.Enabled = False

   TextBox2.Enabled = False

   TextBox3.Enabled = False

   TextBox4.Enabled = False

   TextBox5.Enabled = False

   CheckBox3.Enabled = False

   CheckBox4.ControlTipText = "Поля От и До должны быть заполнены."Sub

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

Option Compare Textk, m As Integer

Dim temp As Integernum As Integer

Dim ie As Integer, var1 As Double, var2 As Double, var3 As DoubleSub chb3_Change()

   If chb3.Value = False Then

       txt6.Enabled = False

       txt7.Enabled = False

       txt6.Value = ""

       txt7.Value = ""

   Else

       txt6.Enabled = True

       txt7.Enabled = True

       txt6.Value = ""

       txt7.Value = ""

   End IfSubSub ComboBox1_Change()

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

   temp2 = temp

   Do While Workbooks("Firms.xls").Worksheets(ComboBox2.Value).Cells(temp2, 1).MergeCells = False And _

   temp2 <> Workbooks("Firms.xls").Worksheets(ComboBox2.Value).Range("End" & num).Row

       If ComboBox1.Value = Workbooks("Firms").Worksheets(ComboBox2.Value).Cells(temp2, 1).Value Then

           Exit Do

       End If

       temp2 = temp2 + 1

   Loop

   TextBox3.Text = _

   Workbooks("Firms").Worksheets(ComboBox2.Value).Cells(temp2, 2).Value

   TextBox4.Text = _

   Workbooks("Firms").Worksheets(ComboBox2.Value).Cells(temp2, 4).Value

   TextBox5.Text = _

   CDbl(Workbooks("Firms").Worksheets(ComboBox2.Value).Cells(temp2, 3).Value)

   TextBox6.Text = _

   CDbl(Workbooks("Firms").Worksheets(ComboBox2.Value).Cells(temp2, 5).Value)

   TextBox7.Text = _

   CDbl(Workbooks("Firms").Worksheets(ComboBox2.Value).Cells(temp2, 6).Value)

   TextBox10.Text = _

   Workbooks("Firms").Worksheets(ComboBox2.Value).Cells(temp2, 7).ValueSubSub ComboBox2_Change()

   ComboBox3.Clear

   ComboBox1.Clear

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

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

   For ib = Workbooks("Firms.xls").Worksheets(ComboBox2.Value).Range("Beg" & num).Row + 1 To ie

       If Workbooks("Firms.xls").Worksheets(ComboBox2.Value).Cells(ib, 1).MergeCells = True Then

           ComboBox3.AddItem Workbooks("Firms").Worksheets(ComboBox2.Value).Cells(ib, 1).Value

       End If

   Next ibSubSub ComboBox3_Change()

   ComboBox1.Clear

   k = 0

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

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

  

   For ib = Workbooks("Firms").Worksheets(ComboBox2.Value).Range("Beg" & num).Row + 1 To ie

       If ComboBox3.Value = _

       CStr(Workbooks("Firms").Worksheets(ComboBox2.Value).Cells(ib, 1).Value) And _

       Workbooks("Firms").Worksheets(ComboBox2.Value).Cells(ib, 1).MergeCells = True Then

           k = Workbooks("Firms").Worksheets(ComboBox2.Value).Cells(ib, 1).Row

           Exit For

       End If

   Next ib

   k = k + 1

   temp = k

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

       ComboBox1.AddItem Workbooks("Firms").Worksheets(ComboBox2.Value).Cells(k, 1).Value

       k = k + 1

   LoopSubSub CommandButton2_Click()

   If txt1.Value = "" Or txt2.Value = "" Or txt3.Value = "" Or txt5.Value = "" Or _

   TextBox2.Value = "" Then

       MsgBox "Вы ввели неполную информацию в разделе Личные данные!", vbCritical, "Ошибка!"

       Exit Sub

   End If

   If DTPicker1.Value > Date Then

       MsgBox "Вы из будущего? Введите правильную дату.", vbCritical, "Ошибка!"

       Exit Sub

   End If

   If IsNumeric(txt5.Value) = False Then

       MsgBox "Неправильный формат данных в поле Телефон!", vbCritical, "Ошибка!"

       Exit Sub

   End If

   If obm.Value = False And obj.Value = False Then

       MsgBox "Выберите один из вариантов в разделе Пол!", vbCritical, "Ошибка!"

       Exit Sub

   End If

   If chb3.Value = True Then

       If txt6.Value = "" Or txt7.Value = "" Then

           MsgBox "Введите все данные в разделе Паспортные данные!", vbCritical, "Ошибка!"

           Exit Sub

       End If

   End If

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

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

       MsgBox "Неправильный тип данных в разделе Паспортные данные!", vbCritical, "Ошибка!"

       Exit Sub

   End If

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

       MsgBox "Выберите все необходимые данные в разделе Путевок", vbCritical, "Ошибка!"

       Exit Sub

   End If

   If TextBox3.Text = "0" Or TextBox4.Text = "0" Then

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

       Exit Sub

   End If

   If TextBox8.Value = "" And TextBox9.Value = "" Then

       MsgBox "Не введено количество мест.", vbCritical, "Ошибка!"

       Exit Sub

   End If

   If CInt(TextBox8.Value) < 0 Or CInt(TextBox9.Value) < 0 Then

       MsgBox "Ошибка при вводе количества мест.", vbCritical, "Ошибка!"

       Exit Sub

   End If

   If CInt(TextBox8.Value) > CInt(TextBox3.Value) Or CInt(TextBox9.Value) > CInt(TextBox4.Value) Then

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

       Exit Sub

   End If

   If TextBox8.Text = "" Then TextBox8.Text = 0

   If TextBox9.Text = "" Then TextBox9.Text = 0

   If TextBox8.Text = "" And TextBox9.Text = "" Then

   MsgBox "Введите количества мест, отличных от нуля", vbCritical, "Ошибка!"

   Exit Sub

   End If

   i = Selection.Row

   Cells(i, 2).Value = CStr(txt1.Text)

   Cells(i, 3).Value = CStr(txt2.Text)

   Cells(i, 4).Value = CStr(txt3.Text)

   Cells(i, 6).Value = DTPicker1.Value

   Cells(i, 7).Value = CStr(txt5.Text)

   Cells(i, 8).Value = CStr(TextBox2.Text)

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

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

   If chb1.Value = True Then

       Cells(i, 14).Value = "Оплачено"

   Else

       Cells(i, 14).Value = "Не оплачено"

   End If

   If chb2.Value = True Then

       Cells(i, 15).Value = "Сдано"

   Else

       Cells(i, 15).Value = "Не сдано"

   End If

   If chb3.Value = True Then

       Cells(i, 12).Value = "Да"

   Else

       Cells(i, 12).Value = "Нет"

   End If

   Cells(i, 13).Value = CStr(txt6.Text & ", " & txt7.Text)

   Cells(i, 10).Value = CStr(ComboBox3.Value)

   Cells(i, 9).Value = CStr(ComboBox2.Value)

   Cells(i, 11).Value = CStr(ComboBox1.Value)

   var1 = TextBox8.Text * TextBox5.Text

   var2 = TextBox9.Text * TextBox6.Text

   var3 = TextBox7.Text * (CInt(TextBox8.Text) + CInt(TextBox9.Text))

   Cells(i, 18).Value = var1 + var2 + var3

   колвз = TextBox8.Text

   колдт = TextBox9.Text

   Cells(i, 16).Value = TextBox8.Text

   Cells(i, 17).Value = TextBox9.Text

   Me.HideSubSub CommandButton3_Click()

   If TextBox3.Text = "0" Or TextBox4.Text = "0" Then

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

       Exit Sub

   End If

   If TextBox8.Value = "" And TextBox9.Value = "" Then

       MsgBox "Не введено количество мест.", vbCritical, "Ошибка!"

       Exit Sub

   End If

   If TextBox8.Text = "" And TextBox9.Text = "" Then

   MsgBox "Введите количества мест, отличных от нуля", vbCritical, "Ошибка!"

   Exit Sub

   End If

   If TextBox8.Value = "" Then TextBox8.Value = 0

   If TextBox9.Value = "" Then TextBox9.Value = 0

  

   If CInt(TextBox8.Value) < 0 Or CInt(TextBox9.Value) < 0 Then

       MsgBox "Ошибка при вводе количества мест.", vbCritical, "Ошибка!"

       Exit Sub

   End If

   If TextBox3.Value = "" And TextBox4.Value = "" Then

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

       Exit Sub

   End If

   If CInt(TextBox8.Value) > CInt(TextBox3.Value) Or CInt(TextBox9.Value) > CInt(TextBox4.Value) Then

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

       Exit Sub

   End If

   var1 = CInt(TextBox8.Value) * CDbl(TextBox5.Value)

   var2 = CInt(TextBox9.Value) * CDbl(TextBox6.Value)

   var3 = CDbl(TextBox7.Value) * (CInt(TextBox8.Value) + CInt(TextBox9.Value))

   TextBox11.Value = var1 + var2 + var3SubSub CommandButton4_Click()

   If txt1.Value = "" Or txt2.Value = "" Or txt3.Value = "" Or txt5.Value = "" Or _

   TextBox2.Value = "" Then

       MsgBox "Вы ввели неполную информацию в разделе Личные данные!", vbCritical, "Ошибка!"

       Exit Sub

   End If

   If DTPicker1.Value > Date Then

       MsgBox "Вы из будущего? Введите правильную дату.", vbCritical, "Ошибка!"

       Exit Sub

   End If

   If IsNumeric(txt5.Value) = False Then

       MsgBox "Неправильный формат данных в поле Телефон!", vbCritical, "Ошибка!"

       Exit Sub

   End If

   If obm.Value = False And obj.Value = False Then

       MsgBox "Выберите один из вариантов в разделе Пол!", vbCritical, "Ошибка!"

       Exit Sub

   End If

   If chb3.Value = True Then

       If txt6.Value = "" Or txt7.Value = "" Then

           MsgBox "Введите все данные в разделе Паспортные данные!", vbCritical, "Ошибка!"

           Exit Sub

       End If

   End If

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

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

       MsgBox "Неправильный тип данных в разделе Паспортные данные!", vbCritical, "Ошибка!"

       Exit Sub

   End If

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

       MsgBox "Выберите все необходимые данные в разделе Путевок", vbCritical, "Ошибка!"

       Exit Sub

   End If

   If TextBox3.Text = "0" Or TextBox4.Text = "0" Then

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

       Exit Sub

   End If

   If TextBox8.Value = "" And TextBox9.Value = "" Then

       MsgBox "Не введено количество мест.", vbCritical, "Ошибка!"

       Exit Sub

   End If

   If CInt(TextBox8.Value) < 0 Or CInt(TextBox9.Value) < 0 Then

       MsgBox "Ошибка при вводе количества мест.", vbCritical, "Ошибка!"

       Exit Sub

   End If

   If CInt(TextBox8.Value) > CInt(TextBox3.Value) Or CInt(TextBox9.Value) > CInt(TextBox4.Value) Then

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

       Exit Sub

   End If

   If TextBox8.Text = "" Then TextBox8.Text = 0

   If TextBox9.Text = "" Then TextBox9.Text = 0

   If TextBox8.Text = "" And TextBox9.Text = "" Then

   MsgBox "Введите количества мест, отличных от нуля", vbCritical, "Ошибка!"

   Exit Sub

   End If

   i = Selection.Row

   Cells(i, 2).Value = CStr(txt1.Text)

   Cells(i, 3).Value = CStr(txt2.Text)

   Cells(i, 4).Value = CStr(txt3.Text)

   Cells(i, 6).Value = DTPicker1.Value

   Cells(i, 7).Value = CStr(txt5.Text)

   Cells(i, 8).Value = CStr(TextBox2.Text)

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

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

   If chb1.Value = True Then

       Cells(i, 14).Value = "Оплачено"

   Else

       Cells(i, 14).Value = "Не оплачено"

   End If

   If chb2.Value = True Then

       Cells(i, 15).Value = "Сдано"

   Else

       Cells(i, 15).Value = "Не сдано"

   End If

   If chb3.Value = True Then

       Cells(i, 12).Value = "Да"

   Else

       Cells(i, 12).Value = "Нет"

   End If

   Cells(i, 13).Value = CStr(txt6.Text & ", " & txt7.Text)

   Cells(i, 10).Value = CStr(ComboBox3.Value)

   Cells(i, 9).Value = CStr(ComboBox2.Value)

   Cells(i, 11).Value = CStr(ComboBox1.Value)

   var1 = TextBox8.Text * TextBox5.Text

   var2 = TextBox9.Text * TextBox6.Text

   var3 = TextBox7.Text * (CInt(TextBox8.Text) + CInt(TextBox9.Text))

   Cells(i, 18).Value = var1 + var2 + var3

   колвз = TextBox8.Text

   колдт = TextBox9.Text

   Cells(i, 16).Value = TextBox8.Text

   Cells(i, 17).Value = TextBox9.Text

   If TextBox3.Text = "0" Or TextBox4.Text = "0" Then

       Exit Sub

   End If

   rowneed = Selection.Row

   i = 3

   Do

       i = i + 1

   Loop While Workbooks("Main.xls").Worksheets("Заказы").Cells(i, 1).Value <> ""

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

       num = 1

   Else

       num = Workbooks("Main.xls").Worksheets("Заказы").Cells(i - 1, 1).Value + 1

   End If

   With Workbooks("Main.xls")

       .Worksheets("ВыхФорма").Unprotect Password:="list"

       .Worksheets("ВыхФорма").Cells(3, 2).Value = .Worksheets("Заказы").Cells(rowneed, 1).Value

       .Worksheets("ВыхФорма").Cells(4, 2).Value = .Worksheets("Заказы").Cells(rowneed, 2).Value

       .Worksheets("ВыхФорма").Cells(5, 2).Value = .Worksheets("Заказы").Cells(rowneed, 3).Value

       .Worksheets("ВыхФорма").Cells(6, 2).Value = .Worksheets("Заказы").Cells(rowneed, 4).Value

       .Worksheets("ВыхФорма").Cells(7, 2).Value = .Worksheets("Заказы").Cells(rowneed, 5).Value

       .Worksheets("ВыхФорма").Cells(8, 2).Value = .Worksheets("Заказы").Cells(rowneed, 6).Value

       .Worksheets("ВыхФорма").Cells(9, 2).Value = .Worksheets("Заказы").Cells(rowneed, 7).Value

       .Worksheets("ВыхФорма").Cells(10, 2).Value = .Worksheets("Заказы").Cells(rowneed, 8).Value

       .Worksheets("ВыхФорма").Cells(11, 2).Value = .Worksheets("Заказы").Cells(rowneed, 9).Value

       .Worksheets("ВыхФорма").Cells(12, 2).Value = .Worksheets("Заказы").Cells(rowneed, 10).Value

       .Worksheets("ВыхФорма").Cells(13, 2).Value = .Worksheets("Заказы").Cells(rowneed, 11).Value

       .Worksheets("ВыхФорма").Cells(14, 2).Value = .Worksheets("Заказы").Cells(rowneed, 12).Value

       .Worksheets("ВыхФорма").Cells(15, 2).Value = .Worksheets("Заказы").Cells(rowneed, 13).Value

       .Worksheets("ВыхФорма").Cells(16, 2).Value = .Worksheets("Заказы").Cells(rowneed, 14).Value

       .Worksheets("ВыхФорма").Cells(17, 2).Value = .Worksheets("Заказы").Cells(rowneed, 15).Value

       .Worksheets("ВыхФорма").Cells(18, 2).Value = .Worksheets("Заказы").Cells(rowneed, 16).Value

       .Worksheets("ВыхФорма").Cells(19, 2).Value = .Worksheets("Заказы").Cells(rowneed, 17).Value

       .Worksheets("ВыхФорма").Cells(20, 2).Value = .Worksheets("Заказы").Cells(rowneed, 18).Value

       .Worksheets("ВыхФорма").Activate

       '.Worksheets("ВыхФорма").Protect Password:="list", DrawingObjects:=True, Contents:=True, Scenarios:=True, _

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

   End With

   Me.HideSubSub UserForm_Activate()

   ActiveSheet.Unprotect Password:="list"SubSub UserForm_Deactivate()

   ActiveSheet.Protect Password:="list"SubSub UserForm_Initialize()

   txt6.MaxLength = 4

   txt7.MaxLength = 6

   DTPicker1.MaxDate = Now

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

       If Sheet.Name <> "1" Then

           ComboBox2.AddItem Sheet.Name

       End If

   Next Sheet

   TextBox3.Text = ""

   TextBox4.Text = ""

   TextBox5.Text = ""

   TextBox6.Text = ""

   TextBox7.Text = ""

   TextBox10.Text = ""SubSub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

   If Cancel = 0 Then ex = 0Sub

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

Private Sub CommandButton18_Click()

   Me.Hide

   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.ShowSubSub CommandButton10_Click()

   Me.Hide

   NewZaSubSub CommandButton13_Click()

   Me.Hide

   EditZaSubSub CommandButton16_Click()

   Me.Hide

   DelZaSubSub 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 IfSubSub CommandButton3_Click()

   Workbooks("Firms.xls").Activate

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

   Me.HideSubSub CommandButton4_Click()

   Me.Hide

   Workbooks("Main.xls").Worksheets("СписокФирм").ActivateSubSub CommandButton5_Click()

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

   Me.HideSubSub CommandButton6_Click()

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

   Me.HideSubSub CommandButton7_Click()

   Application.QuitSubSub UserForm_Activate()

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

   Caption = Space(95) & "Главное меню" & Space(75)Sub

//Workbook(“Main.xls”) Module1

Public ex As Integerколвз As Double, колдт As DoubleОформить(nrow, max)

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

   'ActiveSheet.Unprotect Password:="list"

   Range(Cells(nrow, 1), Cells(nrow, max)).Select

       With Selection

       .HorizontalAlignment = xlCenter

       .VerticalAlignment = xlCenter

       .WrapText = True

       .Orientation = 0

       .AddIndent = False

       .IndentLevel = 0

       .ShrinkToFit = False

       .ReadingOrder = xlContext

       .MergeCells = False

   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

       .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 WithSubNewZa()

   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"SubEditZa()

   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

       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"SubDelZa()

   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".DeleteSubMainS()

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

   Main.ShowSubShowPut()

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

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

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

   SubMain.ShowSub

//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"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

   LoopSubSub 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 ibSubSub 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 ibSubSub 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 IfSubSub 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.HideSubSub 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 = TrueSubSub UserForm_Initialize()

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

   ActiveSheet.Unprotect Password:="list"SubSub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

   If Cancel = 0 Then ex = 0Sub

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

Option Compare Textptemp As StringSub 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.HideSubSub 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 = ""SubSub UserForm_Initialize()

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

   ActiveSheet.Unprotect Password:="list"SubSub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

   If Cancel = 0 Then ex = 0Sub

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

Option Compare Texttemp As IntegerSub 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 = FalseSubSub 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

   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 ibSubSub 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 WithSubSub 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 WithSubSub 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 = TrueSubSub UserForm_Initialize()

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

   ActiveSheet.Unprotect Password:="list"Sub

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

Option Compare TextSub 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.HideSubSub UserForm_Activate()

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

   ActiveSheet.Unprotect Password:="list"SubSub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

   If Cancel = 0 Then ex = 0Sub

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

Dim k, m As Integertemp As Integernum As Integerie 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

   LoopSubSub 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

       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 IfSubSub 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 ibSubSub UserForm_Deactivate()

   ComboBox1.Clear

   ComboBox2.ClearSubSub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

   If Cancel = 0 Then ex = 0Sub

//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).ActivateSubSub UserForm_Activate()

   ComboBox1.Clear

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

       If Sheet.Name <> "1" Then

           ComboBox1.AddItem Sheet.Name

       End If

   Next SheetSubSub UserForm_Deactivate()

   ComboBox1.ClearSubSub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

   If Cancel = 0 Then ex = 0Sub

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

Option Compare TextSub 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"SubSub UserForm_Activate()

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

   ActiveSheet.Unprotect Password:="list"

   lblNaim.ControlTipText = _

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

   txtNaim = ""

   txtAdr = ""

   txtTel1 = ""

   txtTel2 = ""

   txtSite = ""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 SubSubSub CommandButton12_Click()

   Me.Hide

   ex = 1

   listFirm.Show

   If ex = 0 Then Exit Sub

   ex = 1

   EditPut

   If ex = 0 Then Exit SubSubSub CommandButton14_Click()

   Me.Hide

   ex = 1

   listFirm.Show

   If ex = 0 Then Exit Sub

   ex = 1

   DeleteFirm

   If ex = 0 Then Exit SubSubSub CommandButton15_Click()

   Me.Hide

   ex = 1

   listFirm.Show

   If ex = 0 Then Exit Sub

   ex = 1

   DeleteCoun

   If ex = 0 Then Exit SubSubSub 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 IfSubSub CommandButton18_Click()

   Me.Hide

   ShowListSubSub CommandButton7_Click()

   Workbooks("Firms.xls").Save

   Workbooks("Main.xls").Save

   Application.QuitSubSub CommandButton8_Click()

   Me.Hide

   NewFirmLoSubSub CommandButton9_Click()

   Me.Hide

   ex = 1

   listFirm.Show

   If ex = 0 Then Exit Sub

   ex = 1

   NewPut

   If ex = 0 Then Exit SubSubSub UserForm_Activate()

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

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

//Workbook(“Firms.xls”) Module1

Public ex As IntegerCompare TextCreateTable()

   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

   With Selection.Borders(xlInsideHorizontal)

       .LineStyle = xlContinuous

       .Weight = xlMedium

       .ColorIndex = xlAutomatic

   End With

   With Selection.Interior

       .ColorIndex = 19

       .Pattern = xlSolid

       .PatternColorIndex = xlAutomatic

   End WithSubNewPut()

   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 SubSubEditFirm()

   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

   ActiveSheet.Name = CStr(frmEditFirm.txtNaim.Text)

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

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

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

   ActiveSheet.Range("E1").Value = ""

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

   ActiveSheet.Range("E1").Hyperlinks.Add Anchor:=ActiveSheet.Range("E1"), Address:="http://" & frmEditFirm.txtSite.Text

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

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

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

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

   ActiveSheet.Unprotect Password:="list"

   Application.DisplayAlerts = False

   string1 = "Firms.xls"

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

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

       Exit Sub

   End If

   i = MsgBox("Удаляем фирму (" & ActiveSheet.Name & ")?", vbInformation + vbOKCancel, "Внимание!")

   If i = 1 Then

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

       ActiveSheet.Unprotect Password:="list"

       x = ActiveSheet.Index

       ActiveSheet.Delete

       For i = x To Worksheets.Count

           Names.Add Name:="End" & i, RefersTo:=Worksheets(i).Range("End" & i + 1), Visible:=True

           Names.Add Name:="Beg" & i, RefersTo:=Worksheets(i).Range("Beg" & i + 1), Visible:=True

       Next i

       Application.DisplayAlerts = True

   Else

       Exit Sub

   End If

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

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

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

   ex = 1

   listFirm.Show

   If ex = 0 Then Exit SubSubNewFirmLo()

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

   ActiveSheet.Unprotect Password:="list"

   Workbooks("Firms").Worksheets("1").Activate

   ex = 1

   NewFirm.Show

   If ex = 0 Then Exit Sub

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

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

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

   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

   num = Workbooks("Firms.xls").ActiveSheet.Index

   ie = Workbooks("Firms.xls").ActiveSheet.Range("End" & num).Row

   If ie = 6 Then

       MsgBox "В базе нет путевок - нечего редактировать.", vbCritical, "Ошибка!"

       Exit Sub

   End If

   frmSelPut.CommandButton5.Visible = True

   frmSelPut.Show

   If ex = 0 Then Exit Sub

   ex = 1

   temp = ActiveCell.Row

   gorod = Cells(temp, 1)

   i = temp

   Do While Cells(i, 1).MergeCells = False

       i = i - 1

   Loop

   frmPInfo.Label1.Caption = ActiveSheet.Name

   frmPInfo.TextBox1.Text = Cells(i, 1).Value

   frmPInfo.TextBox2.Text = gorod

   frmPInfo.TextBox3.Text = Cells(temp, 2).Value

   frmPInfo.TextBox5.Text = Cells(temp, 3).Value

   frmPInfo.TextBox4.Text = Cells(temp, 4).Value

   frmPInfo.TextBox6.Text = Cells(temp, 5).Value

   frmPInfo.TextBox7.Text = Cells(temp, 6).Value

   frmPInfo.TextBox8.Text = Cells(temp, 8).Value

   frmPInfo.TextBox9.Text = Cells(temp, 10).Value

   If Cells(temp, 7).Value = 7 Then frmPInfo.OptionButton1 = True

   If Cells(temp, 7).Value = 14 Then frmPInfo.OptionButton2 = True

   If Cells(temp, 7).Value = 21 Then frmPInfo.OptionButton3 = True

   If Cells(temp, 9).Value = 1 Then frmPInfo.OptionButton4 = True

   If Cells(temp, 9).Value = 2 Then frmPInfo.OptionButton6 = True

   If Cells(temp, 9).Value = 3 Then frmPInfo.OptionButton7 = True

   If Cells(temp, 9).Value = 4 Then frmPInfo.OptionButton8 = True

   If Cells(temp, 9).Value = 5 Then frmPInfo.OptionButton5 = True

   frmPInfo.Show

   If ex = 0 Then Exit Sub

   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(temp, 3).Value = CDbl(.TextBox5.Value)

       Cells(temp, 5).Value = CDbl(.TextBox6.Text)

       Cells(temp, 6).Value = CDbl(.TextBox7.Text)

       Cells(temp, 2).Value = CInt(.TextBox3.Text)

       Cells(temp, 4).Value = CInt(.TextBox4.Text)

       Cells(temp, 8).Value = CStr(.TextBox8.Text)

       Cells(temp, 10).Value = CStr(.TextBox9.Text)

       If .OptionButton1 = True Then

           Cells(temp, 7).Value = CInt(7)

       End If

       If .OptionButton2 = True Then

           Cells(temp, 7).Value = CInt(14)

       End If

       If .OptionButton3 = True Then

           Cells(temp, 7).Value = CInt(21)

       End If

       If .OptionButton4 = True Then

           Cells(temp, 9).Value = CInt(1)

       End If

       If .OptionButton5 = True Then

           Cells(temp, 9).Value = CInt(5)

       End If

       If .OptionButton6 = True Then

           Cells(temp, 9).Value = CInt(2)

       End If

       If .OptionButton7 = True Then

           Cells(temp, 9).Value = CInt(3)

       End If

       If .OptionButton8 = True Then

           Cells(temp, 9).Value = CInt(4)

       End If

   End With

   frmPInfo.Label1.Caption = ""

   frmPInfo.TextBox1.Text = ""

   frmPInfo.TextBox2.Text = ""

   frmPInfo.TextBox3.Text = ""

   frmPInfo.TextBox4.Text = ""

   frmPInfo.TextBox5.Text = ""

   frmPInfo.TextBox6.Text = ""

   frmPInfo.TextBox7.Text = ""

   frmPInfo.TextBox8.Text = ""

   frmPInfo.TextBox9.Text = ""

   frmPInfo.OptionButton1 = False

   frmPInfo.OptionButton2 = False

   frmPInfo.OptionButton3 = False

   frmPInfo.OptionButton4 = False

   frmPInfo.OptionButton5 = False

   frmPInfo.OptionButton6 = False

   frmPInfo.OptionButton7 = False

   frmPInfo.OptionButton8 = False

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

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

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

   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

   num = Workbooks("Firms.xls").ActiveSheet.Index

   ie = Workbooks("Firms.xls").ActiveSheet.Range("End" & num).Row

   If ie = 6 Then

       MsgBox "В базе нет путевок - нечего удалять.", vbCritical, "Ошибка!"

       Exit Sub

   End If

   ex = 1

   frmDelCoun.Show

   If ex = 0 Then Exit Sub

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

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

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

   Range("A1").SelectSubShowCountry()

   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

   num = Workbooks("Firms.xls").ActiveSheet.Index

   ie = Workbooks("Firms.xls").ActiveSheet.Range("End" & num).Row

   If ie = 6 Then

       MsgBox "В базе нет путевок - нечего искать.", vbCritical, "Ошибка!"

       Exit Sub

   End If

   ex = 1

   frmSelPut.Show

   If ex = 0 Then Exit Sub

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

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

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

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

   SubMain.Show

Похожие работы на - Разработка базы данных 'Туризм и отдых'

 

Не нашли материал для своей работы?
Поможем написать уникальную работу
Без плагиата!