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

 

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

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

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

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

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







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

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

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

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

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





Студент: М.О. Чиркова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

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

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

End If

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

DTPicker1.MinDate = "01.01.1900"

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

End If

Next ib

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

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

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

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

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

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

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

Exit For

End If

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

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

Next Str1

End With

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

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

' Workbooks("Firms").Protect Password:="Firms1"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

TextBox1.Enabled = False

TextBox2.Enabled = False

TextBox3.Enabled = True

CommandButton3.Enabled = False

CommandButton4.Enabled = True

' ComboBox1.MatchRequired = True

' ComboBox1.MatchEntry = fmMatchEntryComplete

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

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

num = ActiveSheet.Index

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

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

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

ComboBox1.AddItem Cells(ib, 1).Value

End If

Next 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

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

Exit Sub

End If

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

flag = 0

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

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

flag = 1

Exit For

End If

Next ib

If flag = 0 Then

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

ComboBox1.Value = ""

ComboBox2.Value = ""

Exit Sub

End If

flag2 = 0

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

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

flag2 = 1

Exit Do

End If

temp = temp + 1

Loop

If flag2 = 0 Then

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

ComboBox2.Value = ""

Exit Sub

End If

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

Me.Hide

End If

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

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

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

NR = Cells(ib, 1).Row

flag = 1

Exit For

End If

Next ib

If flag = 0 Then

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

ComboBox1.Value = ""

ComboBox2.Value = ""

Exit Sub

End If

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

Me.Hide

End 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

End With

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


Министерство образования Нижегородской области Государственное бюджетное образовательное учреждение Среднего профессионального образования "Нижего

Больше работ по теме:

КОНТАКТНЫЙ EMAIL: [email protected]

Скачать реферат © 2019 | Пользовательское соглашение

Скачать      Реферат

ПРОФЕССИОНАЛЬНАЯ ПОМОЩЬ СТУДЕНТАМ