Период времени
|
Концепция
использования информации
|
Вид
информационной системы - ИС
|
Цель
использования ИС
|
1950 - 1960 гг.
|
Бумажный поток
расчетных документов
|
ИТ обработки
расчетных документов на электромеханических бухгалтерских машинах
|
Повышение
скорости обработки документов. Упрощение процедуры обработки счетов и расчета
зарплаты
|
1960 - 1970 гг.
|
Основная помощь
в подготовке отчетов
|
Управленческие
ИТ для производственной информации
|
Ускорение
процесса подготовки отчетности
|
1970 1980 гг.
|
Управленческий
контроль реализации (продаж)
|
Системы
поддержки принятия решений. Системы для высшего звена управления.
|
Выработка
наиболее рационального решения
|
1980 - 2000 гг.
|
Информация -
стратегический ресурс, обеспечивающий конкурентное преимущество
|
Стратегические
ИТ. Автоматизированные подразделения
|
Повышение
конкурентоспособности предприятия
|
Первые информационные системы появились в 50х
годах. Они были предназначены для обработки счетов и расчета зарплаты, а
реализовывались на электромеханических бухгалтерских счетных машинах. Это
приводило к некоторому сокращению затрат и времени на подготовку бумажных
документов.
-е годы знаменуются изменением отношения к информационным
системам. Информация, полученная из них, стала применяться для периодической
отчетности по многим параметрам. Для этого организациям требовалось
компьютерное оборудование широкого назначения, способное обслуживать множество
функций, а не только обрабатывать счета и считать зарплату.
В 70-х - начале 80-х годов информационные системы
начинают широко использоваться в качестве средства управленческого контроля,
поддерживающего и ускоряющего процесс принятия решений.
К концу 80-х годов концепция использования информационных
систем вновь изменяется. Они становятся стратегическим источником информации и
используются на всех уровнях организации любого профиля. Информационные системы
этого периода, предоставляя вовремя нужную информацию, помогают организации
достичь успеха в своей деятельности, создавать новые товары и услуги, находить
новые рынки сбыта, обеспечивать себе достойных партнеров, организовывать выпуск
продукции по низкой цене и много другое
Информационные технологии (ИТ, Information Technology, IT) - это класс областей
деятельности, относящихся к технологиям управления и обработкой огромного
потока информации с применением вычислительной техники.
Существует несколько точек зрения на развитие информационных
технологий с использованием компьютеров, которые определяются различными
признаками деления.
Общим для всех изложенных ниже подходов является то, что с
появлением персонального компьютера начался новый этап развития информационных
технологий. Основной целью становится удовлетворение персональных
информационных потребностей человека, как для профессиональной сферы, так и для
бытовой.
Выделяют несколько признаков, по которым
можно классифицировать информационные системы.
Основные признаки деления информационных
технологий:
. Классификация ИС по признаку
структурированности задач.
ü Создающие управленческие
отчеты и ориентированные главным образом на обработку данных (поиск,
сортировку, агрегирование, фильтрацию). Менеджер принимает решение, опираясь на
сведения, содержащиеся этих отчетах;
ü Разрабатывающие возможные
альтернативы решения. Принятие решения менеджером при этом сводится к выбору
одной из предложенных ему альтернатив. Информационные системы, разрабатывающие
альтернативы решений, могут быть модельными и экспертными.
2. Классификация ИС по степени
автоматизации.
ü ручные ИС - характеризуются полным
отсутствием современных технических средств обработки информации и выполнением
всех операций человеком;
ü автоматические ИС - выполняют все операции
по переработке информации без участия человека;
ü автоматизированные ИС - предполагают участие в
процессе обработки информации и человека, и технических средств, причем главная
роль отводится компьютеру. В современном толковании в термин
"информационная система" вкладывается понятие автоматизированной
системы.
3. Классификация ИС по характеру
использования информации.
ü Информационно-поисковые системы производят ввод,
систематизацию, хранение, выдачу информации по запросу пользователя без сложных
преобразований данных, например ИПС в библиотеке, в железнодорожных и
авиа-кассах продажи билетов.
ü Информационно-решающие системы осуществляют
операции переработки информации по определенному алгоритму. Среди них можно
провести классификацию по степени воздействия выработанной результатной
информации на процесс принятия решений и выделить два класса: управляющие и
советующие.
4. Классификация ИС по сфере их применения.
ü ИС организационного
управления предназначены для автоматизации функций управленческого
персонала. Учитывая высокую распространенность и разнообразие этого класса
систем, часто термин "информационные системы" получает именно такое
толкование. К этому классу относятся ИС управления как промышленными
организациями, так непромышленными объектами: гостиницами, банками, торговыми
фирмами и др.
ü ИС управления
технологическими процессами служат для автоматизации функций
производственного персонала. Они широко используются при организации
производства для поддержания технологического процесса в металлургической и
машиностроительной промышленности.
ü ИС автоматизированного
проектирования предназначены для автоматизации функций
инженеров-проектировщиков, конструкторов, архитекторов, дизайнеров при создании
новой техники или технологии. Основными функциями САПР являются: инженерные
расчеты, создание графической (чертежей, схем, планов) и проектной
документации, моделирование проектируемых объектов.
ü Интегрированные (корпоративные) ИС
используются для автоматизации большинства функций компаний и охватывают весь
цикл работ - от проектирования до сбыта продукции. Создание таких систем весьма
затруднительно, поскольку требует системного подхода с позиций главной цели,
например получения прибыли, завоевания рынка сбыта и т.д. Такой подход может
привести к существенным изменениям в самой структуре компании, на что может
решиться не каждый менеджер.
.2
Содержательная постановка задачи
Задача данного курсового проекта - разработать базу данных
"Туризм и Отдых", которая должна обеспечивать ведение организации
отдыха и туризма. Ежегодно большое количество людей обращаются в такие фирмы
для обеспечения собственного отдыха, в основном на время отпусков.
База данных должна содержать информацию о туристических
фирмах-партнерах (наименование, адрес, контактные телефоны, адрес сайта,
информацию о путевках (страна, город, количество свободных мест взрослых и
детских, цены на детские и взрослые путевки, цена страховки, длительность
путевки, название отеля, в котором будут проживать клиенты, количество звезд
отеля, дополнительные услуги)). Также в базе данных должна содержаться
информация о клиентах (фамилия, имя, отчество, пол, дата рождения, контактный
телефон, email, наименование фирмы, с которой клиент заключил договор,
направление тура (страна, город), данные паспорта, оплачена ли путевка, сданы
ли заказчиком фотографии, количество приобретенных путевок (взрослых, детских),
стоимость путевки).
База данных "Туризм и Отдых" должна
автоматизировать основную работу менеджера по туризму, которая заключается в
сборе, обработке и хранении информации о клиентах туристических фирм-партнеров,
расчете цен на предоставляемые услуги и обеспечении надежного отдыха. База
должна содержать реестр зарегистрированных клиентов в удобочитаемой форме,
возможность добавлять новых клиентов, редактировать данные о них, осуществлять
поиск клиентов, а также формировать отчетность и печать зарегистрированных
клиентов. Все эти возможности должны быть реализованы и в реестре
зарегистрированных фирм.
Глава 2.
Основы проектирования структуры информационной системы
2.1
Проектирование базы данных
Для разработки базы данных "Туризм и Отдых" нужно
определить всю необходимую входную и выходную информацию, составить граф-схему,
концептуальную модель базы данных, затем написать исходный код программы на
встроенном в MS Excel языке программирования VBA (Visual Basic for Application).
MS Visual Basic - средство разработки программного обеспечения,
разработанное корпорацией Microsoft, включающее язык программирования и среду
разработки приложений.
VBA - немного упрощенная реализация языка программирования Visual Basic,
встроенная в линейку продуктов Microsoft Office (включая версии для MAC OS), а также во
многие другие программные пакеты, такие как Ошибка! Источник ссылки не
найден., Ошибка! Источник ссылки не найден., Ошибка! Источник
ссылки не найден., Ошибка! Источник ссылки не найден. и Ошибка!
Источник ссылки не найден.. VBA - это легкий способ разработки собственных
программ для Windows, передовая и высокоэффективная система разработки
приложений Windows, требующая минимум средств и усилий. Созданные на VBA
приложения и компоненты можно компилировать с помощью оптимизирующего
компилятора, ядро которого идентично применяемому в языке программирования
Microsoft C. VBA предоставляет команды для создания и управления необходимыми
элементами программы в Windows: диалогами, окнами, линейками меню,
раскрывающимися списками, командными списками, панелями инструментов и многие
другие. С помощью Visual Basic for Application (VBA) можно легко и быстро
создавать пользовательские приложения, используя единую для всех офисных
программ среду и язык. Научившись разрабатывать приложения для одной офисной
программы, например Excel, можно создавать приложения и для других офисных
программ, например Access. VBA обладает мощными встроенными интеллектуальными
средствами, которые позволяют даже начинающему пользователя быстро
самостоятельно разрабатывать профессиональные приложения. Например, при
написании кода программы редактор VBA сам предлагает пользователю возможные
продолжения составляемых им инструкций. Другим примером встроенных
интеллектуальных средств VBA является макрорекордер, который переводит все
выполняемые вручную пользователем действия в основном приложении на язык VBA.
Таким образом, макрорекордер позволяет пользователю поручать VBA, самому
создавать большие куски кода разрабатываемого приложения. Макропрограммы VBA
сохраняются в файловом формате, используемом приложением, в котором написан
макрос VBA, а не в отдельных текстовых файлах. Для выполнения макропрограмм VBA
ее надо сначала запустить, используя только то приложение, в котором написан
этот макрос. Несмотря на то, что основные возможности VBA остаются теми же во
всех приложениях Office, каждое приложение добавляет специальные команды и
объекты (в зависимости от конкретного приложения) в Visual Basic for
Applications. Например, VBA в Word содержит команды, относящиеся только к
операциям над текстом в документе, тогда как VBA в Access содержит команды,
относящиеся только к операциям с БД, и т.д. В частности, VBA включает
необходимые команды для использования Object Linking and Embedding (OLE) и
Dynamic Data Exchange (DDE) для связи или совместного использования данных с другими
приложениями Windows. Таким образом, с помощью VBA можно создавать приложения
практически для любой области современных компьютерных технологий:
бизнес-приложений, игры, мультимедиа, базы данных.
База данных "Туризм и Отдых" содержит в себе информацию
о фирмах, предоставляющих путевки и о клиентах, заключивших договор с
определенной фирмой. Она осуществляет хранение, добавление, редактирование,
удаление и поиск этой информации. Для достижения этих целей создаются две
рабочие книги (первая - Firms, содержит
информацию о туристических фирмах, вторая - Main, содержит информацию о клиентах). Первая книга (Firms) состоит из нескольких листов: первый
лист - стартовая работа с базой, остальные листы содержат детальную информацию
о каждой из фирм и услуги, которая фирма может предложить клиенту.
Вторая книга (Main) состоит
из:
1. Стартовая страница работы с базой данных;
2. Страница ("СписокФирм"), содержащая список
зарегистрированных туристических фирм;
. Страницы ("ПоискПутевки"), с помощью
которой можно осуществить поиск необходимой путевки по определенным критериям;
. Страницы "Заказы", где непосредственно
можно осуществить заказ путевки;
. Страницы "Выходная форма", где по запросу
пользователя выводится информация о конкретном заказе.
Для работы с данными создаётся ряд форм, два горизонтальных
меню, облегчающих работу с базой данных, а также дополнительные таблицы для
организации расширенного поиска. Созданные формы должны наглядно отображать
весь необходимый диалог с пользователем.
Выходная информация базы данных представлена в виде отчёта
(таблиц), который можно просмотреть и вывести на печать.
2.2
Концептуальная модель базы данных
Цель концептуального программирования - создание
концептуальной модели данных на основе представлений о предметной области каждого
отдельного типа пользователей. Концептуальная модель представляет собой
описание основных сущностей (таблиц) и связей между ними без учёта принятой
модели базы данных и синтаксиса целевой СУБД. Часто на такой модели
отображаются только имена сущностей (таблиц) без указания их атрибутов.
Представление пользователя включает в себя данные, необходимые конкретному
пользователю для принятия решений или выполнения некоторого задания.
База данных "Туризм и Отдых" состоит из двух
рабочих книг (первая содержит информацию о туристических фирмах, вторая
содержит информацию о клиентах), связанных между собой, каждая из которых
содержит свои формы для просмотра, добавления, редактирования, поиска и вид
выходного отчёта.
Первая книга (Firms) состоит из нескольких листов: первый лист -
стартовая работа с базой, остальные содержат детальную информацию о каждой из
фирм и услуги, которая конкретная фирма может предложить клиенту.
На остальных страницах содержатся такие данные, как:
наименование фирмы, адрес местонахождения, контактные телефоны, адрес сайта
фирмы и информацию о путевках (Страна, Город, Количество свободных мест
взрослых и детских, Цена взрослого и детского билетов, Цена страховки,
Длительность путевки, Название отеля, в котором будет проживать клиент, Количество
звезд отеля, Дополнительные услуги).
Вторая книга (Main) состоит из: рабочего листа "1" -
стартовая работа с базой данных, листа "СписокФирм", содержащего
список зарегистрированных туристических фирм (синхронизация с книгой Firms) и краткую информацию о
них (Наименование фирмы, Адрес, Контактные телефоны, Адрес сайта фирмы), листа
"ПоискПутевки", с помощью которого можно осуществить поиск
необходимой путевки по определенным критериям (Фирма, Страна, Город, Цена
путевки), листа "Заказы", где непосредственно можно осуществить заказ
путевки и листа "Выходная форма", где по запросу пользователя
выводится информация о конкретном заказе.
Рис.1. Схема данных со связями
Глава 3.
Разработка и содержание системы
3.1 Основные
задачи, реализованные в системе
Разработанная база данных "Туризм и Отдых" содержит
всю необходимую менеджеру по туризму информацию о клиентах и о туристических
фирмах-партнерах, предоставляющих свои услуги по организации отдыха клиентов.
Работнику предоставлена возможность удобной организации учета
клиентов и туристических фирм-партнеров с минимальными временными затратами.
С помощью разработанной базы данных её пользователю
предоставляются возможности просмотра имеющейся информации, добавления новой
информации с помощью специальных форм, редактирование уже имеющейся информации,
удаление данных, организации поиска необходимых путевок по некоторым критериям
и уже имеющихся заказов в базе данных.
Готовая программа протестирована и отвечает всем требованиям,
предъявленным заказчиком.
3.2
Информационная модель автоматизированного решения задачи
На начальном этапе разработки базы данных "Туризм и
Отдых" была создана форма Main (Рис.2), которая представляет собой главное меню
программы.
При нажатии кнопки "Перейти в книгу Firms" на экране появится
рабочая книга Firms, в которой можно указать подробную информацию о фирмах и услугах,
которые фирмы смогут предоставить клиенту.
При нажатии на кнопку "Перейти к списку фирм" на
экране появится рабочий лист рабочей книги Main "СписокФирм",
в котором будет отображаться список всех фирм, зарегистрированных в книге Firms.
При нажатии кнопки "Перейти к списку заказов" на
экране отобразится рабочий лист "Заказы" рабочей книги Main, где будет находиться
информация о клиентах, заказавших путевки.
При нажатии на кнопки "Сделать новый заказ",
"Редактировать данные заказа", "Удалить заказ из базы" на
экране отобразится рабочий лист "Заказы" книги Main после чего
предоставляется возможность соответственно внести новый заказ в базу - на
экране отобразится форма frmNewZakaz (Рис.3), на форме имеются кнопки
"Сохранить в базе" и "Сохранить в базе и создать выходную
форму" (при нажатии на нее информация о заказе будет сохранена в базе и
выведена на лист "ВыхФорма"); редактировать уже существующий заказ -
отобразится окно с сообщением какой заказ необходимо изменить (Рис.4), после
ввода номера заказа отобразится форма frmNewZakaz с текущей информацией о
заказе, нажав на кнопку "Сохранить в базе" или "Сохранить в базе
и создать выходную форму" в базу будут внесены изменения; удалить заказ из
базы - отобразится окно с сообщением, какой заказ необходимо удалить из базы, после
чего заказ с определенным номером будет удален из базы.
При нажатии на кнопку "Поиск путевки по критериям"
программа перейдет к рабочему листу "ПоискПутевки" и на экране
отобразится форма Find (Рис.5), после выбора критериев поиска и их подтверждения на
листе "ПоискПутевки" отобразятся результаты поиска.
При нажатии кнопки "Сохранить все данные и выйти"
произойдет сохранение всех данных в рабочих книгах Firms и Main, после чего приложение MS Excel закроется.
Также была создана форма SubMain, которая представляет
собой меню работы с рабочей книгой Firms (Рис.6).
При нажатии на кнопку "Перейти на определенную
фирму" появится форма listFirm (Рис.7), в которой можно выбрать определенную
фирму, после нажатия кнопки ОК программа перейдет на лист выбранной из списка
фирмы.
При нажатии на кнопку "Добавить новую фирму в базу"
на экране отобразится форма NewFirmLo (Рис.8), после ввода необходимых данных будет
создан новый рабочий лист с именем, указанным в поле Наименование формы NewFirmLo.
При нажатии на кнопку "Редактировать данные фирмы"
отобразится форма frmEditFirm (Рис.9), позволяющей изменить информацию об
определенной фирме, после подтверждения ввода новых данных данные о фирме будут
изменены.
При нажатии на кнопку "Удалить фирму из базы" будет
отображена форма listFirm, после чего появится окно с сообщением о подтверждении
удаления фирмы из базы (Рис.10), если удаление подтверждено пользователем,
фирма и все ее данные будут удалены из базы.
При нажатии на кнопку "Добавить новую путевку" на
экране появится форма listFirm. Далее будет отображена форма frmNewPut
(Рис.11), в которой есть две возможности (добавить путевку /новая страна и
город/ и добавить путевку /новый город в уже существующей стране/), после ввода
необходимых данных и подтверждения ввода появится форма frmPInfo (Рис.12), в
которой указываются подробные данные о путевке, после чего на листе
определенной фирмы будут внесены соответствующие изменения.
При нажатии на кнопку "Редактировать данные
путевки" появится форма listFirm, далее форма frmSelPut (Рис.13), в которой
предлагается выбрать страну и город путевки, которые необходимо изменить, введя
и подтвердив данные в форме frmSelPut, на экране отобразится форма frmPInfo.
После ввода новых данных о путевке и подтверждения изменения данных, информация
о путевке определенной фирмы будет изменена.
При нажатии на кнопку "Удалить путевку из базы"
появится форма listFirm, после нее форма frmDelCoun (Рис.14), в которой предлагается
выбрать страну и все ее города, либо определенный город страны путевок, которые
необходимо удалить, подтвердив удаление, информация об определенной путевке
будет удалена из базы.
Рис. 2
Рис. 3
Рис.4
Рис. 5
Рис. 6
Рис. 7
Рис. 8
Рис. 9
Рис. 10
Рис.11
Рис. 12
Рис.13
Рис. 14
3.3
Технология решения задачи
Рис.15 Граф-схема базы данных "Туризм и Отдых".
Рис.15.1 Граф-схема базы данных "Туризм и Отдых".
Продолжение.
Литература
1. А.Ю.
Гарнаев "Самоучитель VBA",
Технология создания пользовательских приложений, С. - П. BHV, 1999.
2. В.Г.
Кузьменко "VBA 2000"
(самоучитель) М., ЗАО "Издательство Бином", 2000.
Приложение
Код программы:
//Workbook(“Main.xls”). Worksheets(“1”)
Private Sub
Worksheet_SelectionChange(ByVal Target As Range)
Main.ShowSub
//Workbook(“Main.xls”).
Worksheets(“СписокФирм”)Sub
Worksheet_Activate()
'Экспорт
maxi = 5
i = 4
Do
If i = 4 And
Cells(i, 1).Value = "" Then Exit Do
i = i + 1
Loop While Cells(i,
1).Value <> ""
Range(Cells(4, 1),
Cells(i, 5)).Delete
Range("A3").Name = "Наим"
a =
Range("Наим").Row + 1
n = 0
For Each Sheet In
Workbooks("Firms").Worksheets
If Sheet.Name
<> "1" Then
For j = 1 To 5
If j = 5
Then
Workbooks("Main").Worksheets("СписокФирм").Cells(a,
j).Hyperlinks.Add _
Anchor:=Workbooks("Main").Worksheets("СписокФирм").Cells(a,
j), _
Address:="http://" & Sheet.Cells(1, j)
Exit
For
End If
Workbooks("Main").Worksheets("СписокФирм").Cells(a, j) = _
Sheet.Cells(1, j)
Stri =
CStr(Sheet.Name)
If j = 1
Then
ActiveSheet.Hyperlinks.Add Anchor:=Workbooks("Main").Worksheets("СписокФирм").Cells(a,
j), _
Address:="C:\Users\Marinkoff\Desktop\Firms.xls", SubAddress:= _
"'" & Stri & "'!A1",
TextToDisplay:=CStr(Sheet.Cells(1, j).Value)
End If
Next j
Оформить a,
maxi
a = a + 1
n = n + 1
End If
Next Sheet
Label1.Caption =
Chr(13) & "В базе данных " & n & " турфирм"
& Chr(13)
Columns("A:E").Select
Selection.RowHeight =
30
Selection.ColumnWidth =
24
If
ActiveSheet.AutoFilterMode = False Then
Range("A3:E3").Select
Selection.AutoFilter
End If
Range("A1").SelectSub
//Workbook(“Main.xls”).
Worksheets(“ПоискПутевки”)
Private Sub
CommandButton1_Click()
i = 4
Do
If i = 4 And
Cells(i, 1).Value = "" Then Exit Do
i = i + 1
Loop While Cells(i,
1).Value <> ""
Range(Cells(4, 1),
Cells(i, 12)).DeleteSubSub CommandButton2_Click()
i = 4
Do
If i = 4 And
Cells(i, 1).Value = "" Then Exit Do
i = i + 1
Loop While Cells(i,
1).Value <> ""
Range(Cells(4, 1),
Cells(i, 12)).Delete
Find.ShowSubSub
CommandButton3_Click()
Workbooks("Main.xls").Worksheets("1").Activate
Main.ShowSub
//Workbook(“Main.xls”).
Worksheets(“Заказы”)
Private Sub
CommandButton1_Click()
Main.ShowSubSub
Worksheet_Activate()
Columns("A:P").Select
Selection.ColumnWidth =
8.71
If
ActiveSheet.AutoFilterMode = False Then
Range("A3:P3").Select
Selection.AutoFilter
End If
Range("A1").Select
i = 3
Do
i = i + 1
Loop While Cells(i,
1).Value <> ""
Kol_Prstr = 4
Label1.Caption =
Chr(13) & "В базе " & i - Kol_Prstr & " заказа
(-ов)"SubSub Worksheet_Change(ByVal Target As Range)
i = 3
Do
i = i + 1
Loop While Cells(i,
1).Value <> ""
Kol_Prstr = 4
Label1.Caption =
Chr(13) & "В базе " & i - Kol_Prstr & " заказа
(-ов)"Sub
//Workbook(“Main.xls”).
Worksheets(“ВыхФорма”)
Private Sub
CommandButton1_Click()
ActiveSheet.PrintOut
Preview:=TrueSubSub CommandButton2_Click()
Workbooks("Main.xls").Worksheets("1").Activate
Main.ShowSub
//Workbook(“Main.xls”)
Private Sub
Workbook_Open()
'
Application.Workbooks.Open "I:\БДТурфирм\Firms.xls"
MenuBars(xlWorksheet).Menus.Add Caption:="&Работа с заказами и путевками",
Before:=11
MenuBars(xlWorksheet).Menus("&Работа с заказами и путевками").MenuItems.Add
_
Caption:="&Перейти в главное меню",
Before:=2, OnAction:="MainS"
MenuBars(xlWorksheet).Menus("&Работа с заказами и путевками").MenuItems.Add
_
Caption:="&Новый заказ",
Before:=3, OnAction:="NewZa"
MenuBars(xlWorksheet).Menus("&Работа с заказами и путевками").MenuItems.Add
_
Caption:="&Редактирование заказа",
Before:=4, OnAction:="EditZa"
MenuBars(xlWorksheet).Menus("&Работа с заказами и путевками").MenuItems.Add
_
Caption:="&Удаление заказа",
Before:=5, OnAction:="DelZa"
MenuBars(xlWorksheet).Menus("&Работа с заказами и путевками").MenuItems.Add
_
Caption:="&Поиск
путевки по определенным критериям", Before:=6, OnAction:="ShowPut"
Worksheets("1").Activate
Main.ShowSub
//Workbook(“Main.xls”) Форма Find
Compare TextSub
CheckBox1_Change()
If CheckBox1.Value =
True Then
ComboBox1.Enabled =
True
For Each Sheet In
Workbooks("Firms.xls").Worksheets
If Sheet.Name
<> "1" Then
ComboBox1.AddItem Sheet.Name
End If
Next Sheet
Else
ComboBox1.Enabled =
False
ComboBox1.Clear
ComboBox2.Clear
ComboBox3.Clear
CheckBox2.Value =
False
ComboBox2.Enabled =
False
CheckBox3.Value =
False
ComboBox3.Enabled =
False
ComboBox2.Clear
Exit Sub
End IfSubSub
CheckBox2_Change()
If CheckBox2.Value =
True Then
ComboBox2.Enabled =
True
CheckBox3.Value =
True
ComboBox3.Enabled =
True
End If
If CheckBox2.Value =
True And CheckBox1.Value = False Then
ComboBox2.Enabled =
True
CheckBox3.Value =
True
ComboBox3.Enabled =
True
For Each Sheet In
Workbooks("Firms.xls").Worksheets
If Sheet.Name
<> "1" Then
num =
Workbooks("Firms").Worksheets(Sheet.Name).Index
ie =
Workbooks("Firms").Worksheets(Sheet.Name).Range("End" &
num).Row
With
Workbooks("Firms").Worksheets(Sheet.Name)
For ib
= .Range("Beg" & num).Row + 1 To ie
If
.Cells(ib, 1).MergeCells = True Then
If ComboBox2.ListCount = 0 Then
ComboBox2.AddItem .Cells(ib, 1).Value
Else
flaf = 0
For k = 0 To ComboBox2.ListCount - 1
If
ComboBox2.List(k) = .Cells(ib, 1).Value Then
flaf = 1
Exit For
Else
flaf = 0
End If
Next k
If flaf = 0 Then
ComboBox2.AddItem .Cells(ib, 1).Value
End If
End
If
End
If
Next ib
End With
End If
Next Sheet
End If
If CheckBox2.Value =
False Then
ComboBox2.Enabled =
False
CheckBox3.Value =
False
ComboBox3.Enabled =
False
ComboBox2.Clear
Exit Sub
End IfSubSub
CheckBox4_Change()
If CheckBox4.Value =
True Then
TextBox2.Enabled =
True
TextBox3.Enabled =
True
TextBox4.Enabled =
True
TextBox5.Enabled =
True
Else
TextBox2.Text =
""
TextBox3.Text =
""
TextBox4.Text =
""
TextBox5.Text =
""
TextBox2.Enabled =
False
TextBox3.Enabled =
False
TextBox5.Enabled =
False
End IfSubSub
ComboBox1_Change()
ComboBox2.Clear
ComboBox3.Clear
If ComboBox1.Value
<> "" Then
num =
Workbooks("Firms").Worksheets(ComboBox1.Value).Index
ie =
Workbooks("Firms").Worksheets(ComboBox1.Value).Range("End"
& num).Row
With Workbooks("Firms").Worksheets(ComboBox1.Value)
For ib =
.Range("Beg" & num).Row + 1 To ie
If
.Cells(ib, 1).MergeCells = True Then
ComboBox2.AddItem .Cells(ib, 1).Value
End If
Next ib
End With
End IfSubSub
ComboBox2_Change()
ComboBox3.Clear
If ComboBox1.Value
<> "" Then
k = 0
num =
Workbooks("Firms.xls").Worksheets(ComboBox1.Value).Index
ie =
Workbooks("Firms.xls").Worksheets(ComboBox1.Value).Range("End"
& num).Row
With
Workbooks("Firms.xls").Worksheets(ComboBox1.Value)
For ib =
.Range("Beg" & num).Row + 1 To ie
If
ComboBox2.Value = CStr(.Cells(ib, 1).Value) And .Cells(ib, 1).MergeCells = True
Then
k =
.Cells(ib, 1).Row
Exit
For
End If
Next ib
k = k + 1
temp = k
Do While
.Cells(k, 1).MergeCells = False And k <> .Range("End" &
num).Row
ComboBox3.AddItem
.Cells(k, 1).Value
k = k + 1
Loop
End With
Else
For Each Sheet In
Workbooks("Firms.xls").Worksheets
flagnet = 0
If Sheet.Name
<> "1" Then
k = 0
num =
Workbooks("Firms.xls").Worksheets(Sheet.Name).Index
ie =
Workbooks("Firms.xls").Worksheets(Sheet.Name).Range("End"
& num).Row
If ie
<> 6 Then
With
Workbooks("Firms.xls").Worksheets(Sheet.Name)
For
ib = .Range("Beg" & num).Row + 1 To ie
If ComboBox2.Value = CStr(.Cells(ib, 1).Value) And .Cells(ib, 1).MergeCells =
True Then
flagnet = 1
k = .Cells(ib, 1).Row
Exit For
End If
Next ib
If
flagnet = 1 Then
k = k + 1
temp = k
Do
While .Cells(k, 1).MergeCells = False And k <> .Range("End"
& num).Row
If ComboBox3.ListCount = 0 Then
ComboBox3.AddItem .Cells(k, 1).Value
k = k + 1
Else
flaf = 0
For p = 0 To ComboBox3.ListCount - 1
If ComboBox3.List(p) = .Cells(k, 1).Value Then
flaf
= 1
Exit For
Else
flaf = 0
End If
Next
p
If flaf = 0 Then
ComboBox3.AddItem .Cells(k, 1).Value
k = k + 1
Else
k
= k + 1
End If
End If
Loop
End
If
End
With
End If
End If
Next Sheet
End IfSubSub
CommandButton1_Click()
flag = 0
flag2 = 0
maxi = 12
k = 0
i = 4
'если ничего не выбрано
If ComboBox1.Value =
"" And ComboBox2.Value = "" _
And
ComboBox3.Value = "" And TextBox2.Text = "" _
And TextBox3.Text =
"" And TextBox4.Text = "" _
And TextBox5.Text =
"" Then
MsgBox "Выберите необходимые критерии для поиска.",
vbCritical, "Ошибка!"
Exit Sub
End If
'если выбрана только
фирма
If
ComboBox1.Value <> "" And ComboBox2.Value = "" _
And ComboBox3.Value =
"" And TextBox2.Text = "" _
And TextBox3.Text =
"" And TextBox4.Text = "" _
And TextBox5.Text =
"" Then
Workbooks("Firms.xls").Worksheets(CStr(ComboBox1.Value)).Activate
Me.Hide
End If
'если выбрана только
страна
If
ComboBox1.Value = "" And ComboBox2.Value <> "" _
And ComboBox3.Value =
"" And TextBox2.Text = "" _
And TextBox3.Text =
"" And TextBox4.Text = "" _
And TextBox5.Text =
"" Then
For Each Sheet In
Workbooks("Firms.xls").Worksheets
k = 0
If Sheet.Name
<> "1" Then
num =
Workbooks("Firms.xls").Worksheets(Sheet.Name).Index
ie =
Workbooks("Firms.xls").Worksheets(Sheet.Name).Range("End"
& num).Row
If ie
<> 6 Then
With
Workbooks("Firms.xls").Worksheets(Sheet.Name)
For
ib = .Range("Beg" & num).Row + 1 To ie
If ComboBox2.Value = CStr(.Cells(ib, 1).Value) And .Cells(ib, 1).MergeCells =
True Then
k = .Cells(ib, 1).Row
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 1).Value
= Sheet.Name
Stri = CStr(Sheet.Name)
Workbooks("Main.xls").Worksheets("ПоискПутевки").Hyperlinks.Add
_
Anchor:=Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i,
1), _
Address:="C:\Users\Marinkoff\Desktop\Firms.xls", SubAddress:= _
"'" & Stri & "'!A1",
TextToDisplay:=CStr(Sheet.Name)
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 2).Value
= CStr(ComboBox2.Value)
Оформить i, maxi
i = i + 1
End If
Next ib
End
With
End If
End If
Next Sheet
Me.Hide
End If
'если выбрана фирма и
страна
If
ComboBox1.Value <> "" And ComboBox2.Value <> ""
_
And ComboBox3.Value =
"" And TextBox2.Text = "" _
And TextBox3.Text =
"" And TextBox4.Text = "" _
And TextBox5.Text =
"" Then
num =
Workbooks("Firms.xls").Worksheets(ComboBox1.Value).Index
ie =
Workbooks("Firms.xls").Worksheets(ComboBox1.Value).Range("End"
& num).Row
If ie <> 6
Then
With
Workbooks("Firms.xls").Worksheets(ComboBox1.Value)
For ib =
.Range("Beg" & num).Row + 1 To ie
If
ComboBox2.Value = CStr(.Cells(ib, 1).Value) And .Cells(ib, 1).MergeCells = True
Then
k =
.Cells(ib, 1).Row
Exit For
End If
Next ib
k = k + 1
For ib = k
To ie
If
.Cells(ib, 1).MergeCells = False And ib <> ie Then
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 1).Value
= ComboBox1.Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 2).Value
= ComboBox2.Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 3).Value
= .Cells(ib, 1).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 4).Value
= .Cells(ib, 2).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 5).Value
= .Cells(ib, 3).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 6).Value
= .Cells(ib, 4).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 7).Value
= .Cells(ib, 5).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 8).Value
= .Cells(ib, 6).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 9).Value
= .Cells(ib, 7).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 10).Value
= .Cells(ib, 8).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i,
11).Value = .Cells(ib, 9).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 12).Value
= .Cells(ib, 10).Value
Оформить i, maxi
i =
i + 1
Else
Exit For
End If
Next ib
End With
End If
Me.Hide
End If
'если выбрана фирма и
цена
If
ComboBox1.Value <> "" And ComboBox2.Value = "" _
And ComboBox3.Value =
"" And TextBox2.Text <> "" _
And TextBox3.Text
<> "" Or TextBox4.Text <> "" _
And TextBox5.Text
<> "" Then
num =
Workbooks("Firms.xls").Worksheets(ComboBox1.Value).Index
ie = Workbooks("Firms.xls").Worksheets(ComboBox1.Value).Range("End"
& num).Row
If ie <> 6
Then
If
TextBox2.Text <> "" And TextBox3.Text <> ""
Then
If
IsNumeric(TextBox3.Text) = True And IsNumeric(TextBox2.Text) = True Then
If
CDbl(TextBox3.Text) > CDbl(TextBox2.Text) Then
flag = 1
Else
MsgBox "Проверьте введенные данные в поле Цена.", vbCritical,
"Ошибка!"
Exit Sub
End If
Else
MsgBox
"Поля От и До должны быть заполнены числами.", vbCritical,
"Ошибка!"
Exit Sub
End If
End If
If
TextBox4.Text <> "" And TextBox5.Text <> ""
Then
If
IsNumeric(TextBox4.Text) = True And IsNumeric(TextBox5.Text) = True Then
If
CDbl(TextBox5.Text) > CDbl(TextBox4.Text) Then
flag2 = 1
Else
MsgBox "Проверьте введенные данные в поле Цена.", vbCritical,
"Ошибка!"
Exit Sub
End If
Else
MsgBox
"Поля От и До должны быть заполнены числами.", vbCritical,
"Ошибка!"
Exit Sub
End If
End If
With
Workbooks("Firms.xls").Worksheets(ComboBox1.Value)
For ib =
.Range("Beg" & num).Row + 1 To ie
If
.Cells(ib, 1).MergeCells = True Then
k =
.Cells(ib, 1).Row
For
beg = k + 1 To ie
If .Cells(beg, 1).MergeCells = False And beg <> ie Then
If flag = 1 And flag2 = 0 Then
If .Cells(beg, 3).Value >= CDbl(TextBox2.Text) _
And .Cells(beg, 3).Value <= CDbl(TextBox3.Text) Then
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 1).Value
= ComboBox1.Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i,
2).Value = .Cells(k, 1).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 3).Value
= .Cells(beg, 1).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 4).Value
= .Cells(beg, 2).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 5).Value
= .Cells(beg, 3).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 6).Value
= .Cells(beg, 4).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 7).Value
= .Cells(beg, 5).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 8).Value
= .Cells(beg, 6).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 9).Value
= .Cells(beg, 7).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 10).Value
= .Cells(beg, 8).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 11).Value
= .Cells(beg, 9).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 12).Value
= .Cells(beg, 10).Value
Оформить i, maxi
i = i + 1
End
If
End If
If flag2 = 1 And flag = 0 Then
If .Cells(beg, 5).Value >= CDbl(TextBox4.Text) _
And .Cells(beg, 5).Value <= CDbl(TextBox5.Text) Then
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 1).Value
= ComboBox1.Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 2).Value
= .Cells(k, 1).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 3).Value
= .Cells(beg, 1).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 4).Value
= .Cells(beg, 2).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 5).Value
= .Cells(beg, 3).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 6).Value
= .Cells(beg, 4).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 7).Value
= .Cells(beg, 5).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 8).Value
= .Cells(beg, 6).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 9).Value
= .Cells(beg, 7).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 10).Value
= .Cells(beg, 8).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 11).Value
= .Cells(beg, 9).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 12).Value
= .Cells(beg, 10).Value
Оформить i, maxi
i = i + 1
End If
End If
If
flag2 = 1 And flag = 1 Then
If .Cells(beg, 5).Value >= CDbl(TextBox4.Text) And _
.Cells(beg, 5).Value <= CDbl(TextBox5.Text) And _
.Cells(beg, 3).Value >= CDbl(TextBox2.Text) And _
.Cells(beg, 3).Value <= CDbl(TextBox3.Text) Then
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 1).Value
= ComboBox1.Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 2).Value
= .Cells(k, 1).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 3).Value
= .Cells(beg, 1).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 4).Value
= .Cells(beg, 2).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 5).Value
= .Cells(beg, 3).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 6).Value
= .Cells(beg, 4).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 7).Value
= .Cells(beg, 5).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 8).Value
= .Cells(beg, 6).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 9).Value
= .Cells(beg, 7).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 10).Value
= .Cells(beg, 8).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 11).Value
= .Cells(beg, 9).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 12).Value
= .Cells(beg, 10).Value
Оформить i, maxi
i = i + 1
End
If
End If
Else
Exit For
End If
Next beg
End If
Next ib
End With
End If
Me.Hide
End If
'если выбрана фирма,
страна, город
If
ComboBox1.Value <> "" And ComboBox2.Value <> ""
_
And ComboBox3.Value
<> "" And TextBox2.Text = "" _
And TextBox3.Text =
"" And TextBox4.Text = "" _
And TextBox5.Text =
"" Then
num =
Workbooks("Firms.xls").Worksheets(ComboBox1.Value).Index
ie =
Workbooks("Firms.xls").Worksheets(ComboBox1.Value).Range("End"
& num).Row
If ie <> 6
Then
With Workbooks("Firms.xls").Worksheets(ComboBox1.Value)
For ib =
.Range("Beg" & num).Row + 1 To ie
If
ComboBox2.Value = CStr(.Cells(ib, 1).Value) And .Cells(ib, 1).MergeCells = True
Then
k =
.Cells(ib, 1).Row
Exit For
End If
Next ib
k = k + 1
For ib = k
To ie
If
.Cells(ib, 1).MergeCells = False And ib <> ie And _
ComboBox3.Value = CStr(.Cells(ib, 1).Value) Then
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 1).Value
= ComboBox1.Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 2).Value
= ComboBox2.Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 3).Value
= .Cells(ib, 1).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 4).Value
= .Cells(ib, 2).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 5).Value
= .Cells(ib, 3).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 6).Value
= .Cells(ib, 4).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 7).Value
= .Cells(ib, 5).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 8).Value
= .Cells(ib, 6).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 9).Value
= .Cells(ib, 7).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 10).Value
= .Cells(ib, 8).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 11).Value
= .Cells(ib, 9).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 12).Value
= .Cells(ib, 10).Value
Оформить i, maxi
End If
Next ib
End With
End If
Me.Hide
End If
'если выбрана фирма,
страна, цена
If
ComboBox1.Value <> "" And ComboBox2.Value <> ""
_
And ComboBox3.Value =
"" And TextBox2.Text <> "" _
And TextBox3.Text
<> "" Or TextBox4.Text <> "" _
And TextBox5.Text
<> "" Then
num =
Workbooks("Firms.xls").Worksheets(ComboBox1.Value).Index
ie =
Workbooks("Firms.xls").Worksheets(ComboBox1.Value).Range("End"
& num).Row
If ie <> 6
Then
If
TextBox2.Text <> "" And TextBox3.Text <> ""
Then
If IsNumeric(TextBox3.Text)
= True And IsNumeric(TextBox2.Text) = True Then
If
CDbl(TextBox3.Text) > CDbl(TextBox2.Text) Then
flag = 1
Else
MsgBox "Проверьте введенные данные в поле Цена.", vbCritical,
"Ошибка!"
Exit Sub
End If
Else
MsgBox
"Поля От и До должны быть заполнены числами.", vbCritical,
"Ошибка!"
Exit Sub
End If
End If
If
TextBox4.Text <> "" And TextBox5.Text <> ""
Then
If
IsNumeric(TextBox4.Text) = True And IsNumeric(TextBox5.Text) = True Then
If
CDbl(TextBox5.Text) > CDbl(TextBox4.Text) Then
flag2 = 1
Else
MsgBox "Проверьте введенные данные в поле Цена.", vbCritical,
"Ошибка!"
Exit Sub
End If
MsgBox
"Поля От и До должны быть заполнены числами.", vbCritical,
"Ошибка!"
Exit Sub
End If
End If
With
Workbooks("Firms.xls").Worksheets(ComboBox1.Value)
For ib =
.Range("Beg" & num).Row + 1 To ie
If
ComboBox2.Value = CStr(.Cells(ib, 1).Value) And .Cells(ib, 1).MergeCells = True
Then
k =
.Cells(ib, 1).Row
Exit For
End If
Next ib
For beg = k
+ 1 To ie
If
.Cells(beg, 1).MergeCells = False And beg <> ie Then
If
flag = 1 And flag2 = 0 Then
If .Cells(beg, 3).Value >= CDbl(TextBox2.Text) _
And
.Cells(beg, 3).Value <= CDbl(TextBox3.Text) Then
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 1).Value
= ComboBox1.Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 2).Value
= ComboBox2.Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 3).Value
= .Cells(beg, 1).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 4).Value
= .Cells(beg, 2).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 5).Value
= .Cells(beg, 3).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 6).Value
= .Cells(beg, 4).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 7).Value
= .Cells(beg, 5).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 8).Value
= .Cells(beg, 6).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 9).Value
= .Cells(beg, 7).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 10).Value
= .Cells(beg, 8).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i,
11).Value = .Cells(beg, 9).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 12).Value
= .Cells(beg, 10).Value
Оформить i, maxi
i = i + 1
End If
End
If
If
flag2 = 1 And flag = 0 Then
If .Cells(beg, 5).Value >= CDbl(TextBox4.Text) _
And .Cells(beg, 5).Value <= CDbl(TextBox5.Text) Then
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 1).Value
= ComboBox1.Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 2).Value
= ComboBox2.Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 3).Value
= .Cells(beg, 1).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 4).Value
= .Cells(beg, 2).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 5).Value
= .Cells(beg, 3).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 6).Value
= .Cells(beg, 4).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 7).Value
= .Cells(beg, 5).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 8).Value
= .Cells(beg, 6).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 9).Value
= .Cells(beg, 7).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 10).Value
= .Cells(beg, 8).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 11).Value
= .Cells(beg, 9).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 12).Value
= .Cells(beg, 10).Value
Оформить i, maxi
i = i + 1
End If
End
If
If
flag2 = 1 And flag = 1 Then
If .Cells(beg, 5).Value >= CDbl(TextBox4.Text) And _
.Cells(beg, 5).Value <= CDbl(TextBox5.Text) And _
.Cells(beg, 3).Value >= CDbl(TextBox2.Text) And _
.Cells(beg, 3).Value <= CDbl(TextBox3.Text) Then
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i,
1).Value = ComboBox1.Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 2).Value
= ComboBox2.Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i,
3).Value = .Cells(beg, 1).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 4).Value
= .Cells(beg, 2).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 5).Value
= .Cells(beg, 3).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 6).Value
= .Cells(beg, 4).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 7).Value
= .Cells(beg, 5).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 8).Value
= .Cells(beg, 6).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 9).Value
= .Cells(beg, 7).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 10).Value
= .Cells(beg, 8).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 11).Value
= .Cells(beg, 9).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 12).Value
= .Cells(beg, 10).Value
Оформить i, maxi
i = i + 1
End If
End
If
Else
Exit For
End If
Next beg
End With
End If
Me.Hide
End If
'если выбрана страна, город
и цена
If
ComboBox1.Value = "" And ComboBox2.Value <> "" _
And ComboBox3.Value
<> "" And TextBox2.Text <> "" _
And TextBox3.Text
<> "" Or TextBox4.Text <> "" _
And TextBox5.Text
<> "" Then
For Each Sheet In
Workbooks("Firms.xls").Worksheets
k = 0
If Sheet.Name
<> "1" Then
num =
Workbooks("Firms.xls").Worksheets(Sheet.Name).Index
ie =
Workbooks("Firms.xls").Worksheets(Sheet.Name).Range("End"
& num).Row
If ie
<> 6 Then
If
TextBox2.Text <> "" And TextBox3.Text <> ""
Then
If
IsNumeric(TextBox3.Text) = True And IsNumeric(TextBox2.Text) = True Then
If CDbl(TextBox3.Text) > CDbl(TextBox2.Text) Then
flag = 1
Else
MsgBox "Проверьте введенные данные в поле Цена.", vbCritical,
"Ошибка!"
Exit Sub
End If
Else
MsgBox "Поля От и До должны быть заполнены числами.", vbCritical,
"Ошибка!"
Exit
Sub
End
If
End If
If
TextBox4.Text <> "" And TextBox5.Text <> ""
Then
If
IsNumeric(TextBox4.Text) = True And IsNumeric(TextBox5.Text) = True Then
If CDbl(TextBox5.Text) > CDbl(TextBox4.Text) Then
flag2 = 1
Else
MsgBox "Проверьте введенные данные в поле Цена.", vbCritical,
"Ошибка!"
Exit Sub
End If
Else
MsgBox "Поля От и До должны быть заполнены числами.", vbCritical,
"Ошибка!"
Exit
Sub
End
If
End If
With
Workbooks("Firms.xls").Worksheets(Sheet.Name)
For
ib = .Range("Beg" & num).Row + 1 To ie
If ComboBox2.Value = CStr(.Cells(ib, 1).Value) And .Cells(ib, 1).MergeCells =
True Then
k = .Cells(ib, 1).Row
Exit For
End If
Next ib
For
beg = k + 1 To ie
If ComboBox3.Value = CStr(.Cells(beg, 1).Value) And .Cells(beg, 1).MergeCells =
False _
And beg <> ie Then
If flag = 1 And flag2 = 0 Then
If .Cells(beg, 3).Value >= CDbl(TextBox2.Text) _
And .Cells(beg, 3).Value <= CDbl(TextBox3.Text) Then
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i,
1).Value = Sheet.Name
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 2).Value
= ComboBox2.Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i,
3).Value = ComboBox3.Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 4).Value
= .Cells(beg, 2).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i,
5).Value = .Cells(beg, 3).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 6).Value
= .Cells(beg, 4).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i,
7).Value = .Cells(beg, 5).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 8).Value
= .Cells(beg, 6).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i,
9).Value = .Cells(beg, 7).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 10).Value
= .Cells(beg, 8).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i,
11).Value = .Cells(beg, 9).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 12).Value
= .Cells(beg, 10).Value
Оформить i, maxi
i = i + 1
Exit For
End If
End If
If flag2 = 1 And flag = 0 Then
If .Cells(beg, 5).Value >= CDbl(TextBox4.Text) _
And .Cells(beg, 5).Value <= CDbl(TextBox5.Text) Then
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 1).Value
= Sheet.Name
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 2).Value
= ComboBox2.Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i,
3).Value = ComboBox3.Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 4).Value
= .Cells(beg, 2).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i,
5).Value = .Cells(beg, 3).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 6).Value
= .Cells(beg, 4).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i,
7).Value = .Cells(beg, 5).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 8).Value
= .Cells(beg, 6).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i,
9).Value = .Cells(beg, 7).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 10).Value
= .Cells(beg, 8).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i,
11).Value = .Cells(beg, 9).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 12).Value
= .Cells(beg, 10).Value
Оформить i, maxi
i = i + 1
Exit For
End If
End If
If flag2 = 1 And flag = 1 Then
If .Cells(beg, 5).Value >= CDbl(TextBox4.Text) And _
.Cells(beg, 5).Value <= CDbl(TextBox5.Text) And _
.Cells(beg, 3).Value >= CDbl(TextBox2.Text) And _
.Cells(beg, 3).Value <= CDbl(TextBox3.Text) Then
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 1).Value
= Sheet.Name
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i,
2).Value = ComboBox2.Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 3).Value
= ComboBox3.Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i,
4).Value = .Cells(beg, 2).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 5).Value
= .Cells(beg, 3).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 6).Value
= .Cells(beg, 4).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 7).Value
= .Cells(beg, 5).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 8).Value
= .Cells(beg, 6).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 9).Value
= .Cells(beg, 7).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 10).Value
= .Cells(beg, 8).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 11).Value
= .Cells(beg, 9).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 12).Value
= .Cells(beg, 10).Value
Оформить i, maxi
i = i + 1
Exit For
End If
End If
End If
Next beg
End
With
End If
End If
Next Sheet
Me.Hide
End If
'если выбрана страна и
город
If
ComboBox1.Value = "" And ComboBox2.Value <> "" _
And ComboBox3.Value
<> "" And TextBox2.Text = "" _
And TextBox3.Text =
"" And TextBox4.Text = "" _
And TextBox5.Text =
"" Then
For Each Sheet In
Workbooks("Firms.xls").Worksheets
k = 0
If Sheet.Name
<> "1" Then
num =
Workbooks("Firms.xls").Worksheets(Sheet.Name).Index
ie =
Workbooks("Firms.xls").Worksheets(Sheet.Name).Range("End"
& num).Row
If ie
<> 6 Then
With
Workbooks("Firms.xls").Worksheets(Sheet.Name)
For
ib = .Range("Beg" & num).Row + 1 To ie
If ComboBox2.Value = CStr(.Cells(ib, 1).Value) And .Cells(ib, 1).MergeCells =
True Then
k = .Cells(ib, 1).Row
Exit For
End If
Next
ib
k =
k + 1
For
ib = k To ie
If .Cells(ib, 1).MergeCells = False And ib <> ie And _
ComboBox3.Value = CStr(.Cells(ib, 1).Value) Then
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i,
1).Value = Sheet.Name
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 2).Value
= ComboBox2.Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 3).Value
= ComboBox3.Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 4).Value
= .Cells(ib, 2).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 5).Value
= .Cells(ib, 3).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 6).Value
= .Cells(ib, 4).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 7).Value
= .Cells(ib, 5).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 8).Value
= .Cells(ib, 6).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 9).Value
= .Cells(ib, 7).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 10).Value
= .Cells(ib, 8).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 11).Value
= .Cells(ib, 9).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 12).Value
= .Cells(ib, 10).Value
Оформить i, maxi
i = i + 1
Exit For
End If
Next ib
End
With
End If
End If
Next Sheet
Me.Hide
End If
'если выбрана страна и цена
If ComboBox1.Value =
"" And ComboBox2.Value <> "" _
And ComboBox3.Value =
"" And TextBox2.Text <> "" _
And TextBox3.Text
<> "" Or TextBox4.Text <> "" _
And TextBox5.Text
<> "" Then
For Each Sheet In
Workbooks("Firms.xls").Worksheets
k = 0
If Sheet.Name
<> "1" Then
num =
Workbooks("Firms.xls").Worksheets(Sheet.Name).Index
ie =
Workbooks("Firms.xls").Worksheets(Sheet.Name).Range("End"
& num).Row
If ie
<> 6 Then
If
TextBox2.Text <> "" And TextBox3.Text <> ""
Then
If
IsNumeric(TextBox3.Text) = True And IsNumeric(TextBox2.Text) = True Then
If CDbl(TextBox3.Text) > CDbl(TextBox2.Text) Then
flag = 1
Else
MsgBox "Проверьте введенные данные в поле Цена.", vbCritical,
"Ошибка!"
Exit Sub
End If
Else
MsgBox "Поля От и До должны быть заполнены числами.", vbCritical,
"Ошибка!"
Exit
Sub
End
If
End If
If
TextBox4.Text <> "" And TextBox5.Text <> ""
Then
If
IsNumeric(TextBox4.Text) = True And IsNumeric(TextBox5.Text) = True Then
If CDbl(TextBox5.Text) > CDbl(TextBox4.Text) Then
flag2 = 1
Else
MsgBox "Проверьте введенные данные в поле Цена.", vbCritical,
"Ошибка!"
Exit Sub
End If
Else
MsgBox "Поля От и До должны быть заполнены числами.", vbCritical,
"Ошибка!"
Exit
Sub
End
If
End If
With
Workbooks("Firms.xls").Worksheets(Sheet.Name)
For
ib = .Range("Beg" & num).Row + 1 To ie
If ComboBox2.Value = CStr(.Cells(ib, 1).Value) And .Cells(ib, 1).MergeCells =
True Then
k = .Cells(ib, 1).Row
Exit For
End
If
Next ib
k =
k + 1
For
ib = k To ie
If .Cells(ib, 1).MergeCells = False And ib <> ie Then
If flag = 1 And flag2 = 0 Then
If .Cells(ib, 3).Value >= CDbl(TextBox2.Text) _
And .Cells(ib, 3).Value <= CDbl(TextBox3.Text) Then
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i,
1).Value = Sheet.Name
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 2).Value
= ComboBox2.Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i,
3).Value = .Cells(ib, 1).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 4).Value
= .Cells(ib, 2).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i,
5).Value = .Cells(ib, 3).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 6).Value
= .Cells(ib, 4).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i,
7).Value = .Cells(ib, 5).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 8).Value
= .Cells(ib, 6).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i,
9).Value = .Cells(ib, 7).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 10).Value
= .Cells(ib, 8).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i,
11).Value = .Cells(ib, 9).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 12).Value
= .Cells(ib, 10).Value
Оформить i, maxi
i = i + 1
End If
End If
If flag2 = 1 And flag = 0 Then
If .Cells(ib, 5).Value >= CDbl(TextBox4.Text) _
And .Cells(ib, 5).Value <= CDbl(TextBox5.Text) Then
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 1).Value
= Sheet.Name
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i,
2).Value = ComboBox2.Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 3).Value
= .Cells(ib, 1).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i,
4).Value = .Cells(ib, 2).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 5).Value
= .Cells(ib, 3).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 6).Value
= .Cells(ib, 4).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 7).Value
= .Cells(ib, 5).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 8).Value
= .Cells(ib, 6).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 9).Value
= .Cells(ib, 7).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 10).Value
= .Cells(ib, 8).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 11).Value
= .Cells(ib, 9).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 12).Value
= .Cells(ib, 10).Value
Оформить i, maxi
i
= i + 1
End If
End If
If flag2 = 1 And flag = 1 Then
If .Cells(ib, 5).Value >= CDbl(TextBox4.Text) And _
.Cells(ib,
5).Value <= CDbl(TextBox5.Text) And _
.Cells(ib, 3).Value >= CDbl(TextBox2.Text) And _
.Cells(ib, 3).Value <= CDbl(TextBox3.Text) Then
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i,
1).Value = Sheet.Name
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 2).Value
= ComboBox2.Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i,
3).Value = .Cells(ib, 1).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 4).Value
= .Cells(ib, 2).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i,
5).Value = .Cells(ib, 3).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 6).Value
= .Cells(ib, 4).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i,
7).Value = .Cells(ib, 5).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 8).Value
= .Cells(ib, 6).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i,
9).Value = .Cells(ib, 7).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 10).Value
= .Cells(ib, 8).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i,
11).Value = .Cells(ib, 9).Value
Workbooks("Main.xls").Worksheets("ПоискПутевки").Cells(i, 12).Value
= .Cells(ib, 10).Value
Оформить i, maxi
i = i + 1
End If
End If
Else
Exit For
Next ib
End
With
End If
End If
Next Sheet
Me.Hide
End IfSubSub
UserForm_Activate()
i = 4
Do
If i = 4 And
Cells(i, 1).Value = "" Then Exit Do
i = i + 1
Loop While Cells(i,
1).Value <> ""
Range(Cells(4, 1),
Cells(i, 12)).Delete
CheckBox1.Value = False
CheckBox2.Value = False
CheckBox3.Value = False
CheckBox4.Value = False
ComboBox1.Clear
ComboBox2.Clear
ComboBox3.Clear
TextBox2.Text =
""
TextBox3.Text =
""
ComboBox1.Enabled =
False
ComboBox2.Enabled =
False
ComboBox3.Enabled =
False
TextBox2.Enabled =
False
TextBox3.Enabled =
False
TextBox4.Enabled =
False
TextBox5.Enabled =
False
CheckBox3.Enabled =
False
CheckBox4.ControlTipText =
"Поля От и До должны быть заполнены."Sub
//Workbook(“Main.xls”) Форма frmNewZakaz
Option Compare Textk, m As
Integer
Dim temp As Integernum As
Integer
Dim ie As Integer, var1 As
Double, var2 As Double, var3 As DoubleSub chb3_Change()
If chb3.Value = False
Then
txt6.Enabled =
False
txt7.Enabled =
False
txt6.Value =
""
txt7.Value =
""
Else
txt6.Enabled = True
txt7.Enabled = True
txt6.Value =
""
txt7.Value =
""
End IfSubSub
ComboBox1_Change()
num =
Workbooks("Firms").Worksheets(ComboBox2.Value).Index
temp2 = temp
Do While
Workbooks("Firms.xls").Worksheets(ComboBox2.Value).Cells(temp2,
1).MergeCells = False And _
temp2 <>
Workbooks("Firms.xls").Worksheets(ComboBox2.Value).Range("End"
& num).Row
If ComboBox1.Value
= Workbooks("Firms").Worksheets(ComboBox2.Value).Cells(temp2,
1).Value Then
Exit Do
End If
temp2 = temp2 + 1
Loop
TextBox3.Text = _
Workbooks("Firms").Worksheets(ComboBox2.Value).Cells(temp2, 2).Value
TextBox4.Text = _
Workbooks("Firms").Worksheets(ComboBox2.Value).Cells(temp2, 4).Value
TextBox5.Text = _
CDbl(Workbooks("Firms").Worksheets(ComboBox2.Value).Cells(temp2,
3).Value)
TextBox6.Text = _
CDbl(Workbooks("Firms").Worksheets(ComboBox2.Value).Cells(temp2,
5).Value)
TextBox7.Text = _
CDbl(Workbooks("Firms").Worksheets(ComboBox2.Value).Cells(temp2,
6).Value)
TextBox10.Text = _
Workbooks("Firms").Worksheets(ComboBox2.Value).Cells(temp2,
7).ValueSubSub ComboBox2_Change()
ComboBox3.Clear
ComboBox1.Clear
num =
Workbooks("Firms.xls").Worksheets(ComboBox2.Value).Index
ie =
Workbooks("Firms.xls").Worksheets(ComboBox2.Value).Range("End"
& num).Row
For ib =
Workbooks("Firms.xls").Worksheets(ComboBox2.Value).Range("Beg"
& num).Row + 1 To ie
If
Workbooks("Firms.xls").Worksheets(ComboBox2.Value).Cells(ib,
1).MergeCells = True Then
ComboBox3.AddItem Workbooks("Firms").Worksheets(ComboBox2.Value).Cells(ib,
1).Value
End If
Next ibSubSub
ComboBox3_Change()
ComboBox1.Clear
k = 0
num =
Workbooks("Firms").Worksheets(ComboBox2.Value).Index
ie =
Workbooks("Firms").Worksheets(ComboBox2.Value).Range("End"
& num).Row
For ib =
Workbooks("Firms").Worksheets(ComboBox2.Value).Range("Beg"
& num).Row + 1 To ie
If ComboBox3.Value
= _
CStr(Workbooks("Firms").Worksheets(ComboBox2.Value).Cells(ib,
1).Value) And _
Workbooks("Firms").Worksheets(ComboBox2.Value).Cells(ib,
1).MergeCells = True Then
k =
Workbooks("Firms").Worksheets(ComboBox2.Value).Cells(ib, 1).Row
Exit For
End If
Next ib
k = k + 1
temp = k
Do While
Workbooks("Firms").Worksheets(ComboBox2.Value).Cells(k, 1).MergeCells
= False And k <>
Workbooks("Firms").Worksheets(ComboBox2.Value).Range("End"
& num).Row
ComboBox1.AddItem
Workbooks("Firms").Worksheets(ComboBox2.Value).Cells(k, 1).Value
k = k + 1
LoopSubSub
CommandButton2_Click()
If txt1.Value =
"" Or txt2.Value = "" Or txt3.Value = "" Or
txt5.Value = "" Or _
TextBox2.Value = "" Then
MsgBox "Вы ввели неполную
информацию в разделе Личные данные!", vbCritical, "Ошибка!"
Exit Sub
End If
If DTPicker1.Value >
Date Then
MsgBox "Вы из будущего?
Введите правильную дату.", vbCritical, "Ошибка!"
Exit Sub
End If
If
IsNumeric(txt5.Value) = False Then
MsgBox "Неправильный формат
данных в поле Телефон!", vbCritical, "Ошибка!"
Exit Sub
End If
If obm.Value = False
And obj.Value = False Then
MsgBox "Выберите один из
вариантов в разделе Пол!", vbCritical, "Ошибка!"
Exit Sub
End If
If chb3.Value = True
Then
If txt6.Value =
"" Or txt7.Value = "" Then
MsgBox "Введите все данные
в разделе Паспортные данные!", vbCritical, "Ошибка!"
Exit Sub
End If
End If
If txt6.Text <>
"" And IsNumeric(txt6.Text) = False _
Or txt7.Text <>
"" And IsNumeric(txt7.Text) = False Then
MsgBox "Неправильный тип
данных в разделе Паспортные данные!", vbCritical, "Ошибка!"
Exit Sub
End If
If ComboBox1.Value =
"" Or ComboBox2.Value = "" Or ComboBox3.Value =
"" Then
MsgBox "Выберите все
необходимые данные в разделе Путевок", vbCritical, "Ошибка!"
Exit Sub
End If
If TextBox3.Text =
"0" Or TextBox4.Text = "0" Then
MsgBox "Все места на данные
путевки распроданы.", vbCritical, "Ошибка!"
Exit Sub
End If
If TextBox8.Value =
"" And TextBox9.Value = "" Then
MsgBox "Не введено
количество мест.", vbCritical, "Ошибка!"
Exit Sub
End If
If CInt(TextBox8.Value)
< 0 Or CInt(TextBox9.Value) < 0 Then
MsgBox "Ошибка при вводе
количества мест.", vbCritical, "Ошибка!"
Exit Sub
End If
If CInt(TextBox8.Value)
> CInt(TextBox3.Value) Or CInt(TextBox9.Value) > CInt(TextBox4.Value)
Then
MsgBox "Введенное
количество мест превышает исходные.", vbCritical, "Ошибка!"
Exit Sub
End If
If TextBox8.Text =
"" Then TextBox8.Text = 0
If TextBox9.Text =
"" Then TextBox9.Text = 0
If TextBox8.Text =
"" And TextBox9.Text = "" Then
MsgBox "Введите количества
мест, отличных от нуля", vbCritical, "Ошибка!"
Exit Sub
End If
i = Selection.Row
Cells(i, 2).Value =
CStr(txt1.Text)
Cells(i, 3).Value =
CStr(txt2.Text)
Cells(i, 4).Value =
CStr(txt3.Text)
Cells(i, 6).Value =
DTPicker1.Value
Cells(i, 7).Value =
CStr(txt5.Text)
Cells(i, 8).Value =
CStr(TextBox2.Text)
If obm.Value = True
Then Cells(i, 5).Value = "Муж"
If obj.Value = True
Then Cells(i, 5).Value = "Жен"
If chb1.Value = True
Then
Cells(i, 14).Value
= "Оплачено"
Else
Cells(i, 14).Value
= "Не оплачено"
End If
If chb2.Value = True
Then
Cells(i, 15).Value
= "Сдано"
Else
Cells(i, 15).Value
= "Не сдано"
End If
If chb3.Value = True
Then
Cells(i, 12).Value
= "Да"
Else
Cells(i, 12).Value
= "Нет"
End If
Cells(i, 13).Value =
CStr(txt6.Text & ", " & txt7.Text)
Cells(i, 10).Value =
CStr(ComboBox3.Value)
Cells(i, 9).Value =
CStr(ComboBox2.Value)
Cells(i, 11).Value =
CStr(ComboBox1.Value)
var1 = TextBox8.Text *
TextBox5.Text
var2 = TextBox9.Text *
TextBox6.Text
var3 = TextBox7.Text *
(CInt(TextBox8.Text) + CInt(TextBox9.Text))
Cells(i, 18).Value =
var1 + var2 + var3
колвз = TextBox8.Text
колдт = TextBox9.Text
Cells(i, 16).Value =
TextBox8.Text
Cells(i, 17).Value =
TextBox9.Text
Me.HideSubSub
CommandButton3_Click()
If TextBox3.Text =
"0" Or TextBox4.Text = "0" Then
MsgBox "Все места на данные
путевки распроданы.", vbCritical, "Ошибка!"
Exit Sub
End If
If TextBox8.Value =
"" And TextBox9.Value = "" Then
MsgBox "Не введено
количество мест.", vbCritical, "Ошибка!"
Exit Sub
End If
If TextBox8.Text =
"" And TextBox9.Text = "" Then
MsgBox "Введите количества
мест, отличных от нуля", vbCritical, "Ошибка!"
Exit Sub
End If
If TextBox8.Value =
"" Then TextBox8.Value = 0
If TextBox9.Value =
"" Then TextBox9.Value = 0
If CInt(TextBox8.Value)
< 0 Or CInt(TextBox9.Value) < 0 Then
MsgBox "Ошибка при вводе
количества мест.", vbCritical, "Ошибка!"
Exit Sub
End If
If TextBox3.Value =
"" And TextBox4.Value = "" Then
MsgBox "Выберите
необходимые данные (фирма, страна, город) для подсчета", vbCritical, "Ошибка!"
Exit Sub
End If
If CInt(TextBox8.Value)
> CInt(TextBox3.Value) Or CInt(TextBox9.Value) > CInt(TextBox4.Value)
Then
MsgBox "Введенное
количество мест превышает исходные.", vbCritical, "Ошибка!"
Exit Sub
End If
var1 =
CInt(TextBox8.Value) * CDbl(TextBox5.Value)
var2 =
CInt(TextBox9.Value) * CDbl(TextBox6.Value)
var3 =
CDbl(TextBox7.Value) * (CInt(TextBox8.Value) + CInt(TextBox9.Value))
TextBox11.Value = var1
+ var2 + var3SubSub CommandButton4_Click()
If txt1.Value =
"" Or txt2.Value = "" Or txt3.Value = "" Or
txt5.Value = "" Or _
TextBox2.Value = "" Then
MsgBox "Вы ввели неполную
информацию в разделе Личные данные!", vbCritical, "Ошибка!"
Exit Sub
End If
If DTPicker1.Value >
Date Then
MsgBox "Вы из будущего?
Введите правильную дату.", vbCritical, "Ошибка!"
Exit Sub
End If
If
IsNumeric(txt5.Value) = False Then
MsgBox "Неправильный формат
данных в поле Телефон!", vbCritical, "Ошибка!"
Exit Sub
End If
If obm.Value = False
And obj.Value = False Then
MsgBox "Выберите один из
вариантов в разделе Пол!", vbCritical, "Ошибка!"
Exit Sub
End If
If chb3.Value = True
Then
If txt6.Value =
"" Or txt7.Value = "" Then
MsgBox "Введите все данные
в разделе Паспортные данные!", vbCritical, "Ошибка!"
Exit Sub
End If
End If
If txt6.Text <>
"" And IsNumeric(txt6.Text) = False _
Or txt7.Text <>
"" And IsNumeric(txt7.Text) = False Then
MsgBox "Неправильный тип
данных в разделе Паспортные данные!", vbCritical, "Ошибка!"
Exit Sub
End If
If ComboBox1.Value =
"" Or ComboBox2.Value = "" Or ComboBox3.Value =
"" Then
MsgBox "Выберите все
необходимые данные в разделе Путевок", vbCritical, "Ошибка!"
Exit Sub
End If
If TextBox3.Text =
"0" Or TextBox4.Text = "0" Then
MsgBox "Все места на данные
путевки распроданы.", vbCritical, "Ошибка!"
Exit Sub
End If
If TextBox8.Value =
"" And TextBox9.Value = "" Then
MsgBox "Не введено
количество мест.", vbCritical, "Ошибка!"
Exit Sub
End If
If CInt(TextBox8.Value)
< 0 Or CInt(TextBox9.Value) < 0 Then
MsgBox "Ошибка при вводе
количества мест.", vbCritical, "Ошибка!"
Exit Sub
End If
If CInt(TextBox8.Value)
> CInt(TextBox3.Value) Or CInt(TextBox9.Value) > CInt(TextBox4.Value)
Then
MsgBox "Введенное
количество мест превышает исходные.", vbCritical, "Ошибка!"
Exit Sub
End If
If TextBox8.Text =
"" Then TextBox8.Text = 0
If TextBox9.Text =
"" Then TextBox9.Text = 0
If TextBox8.Text =
"" And TextBox9.Text = "" Then
MsgBox "Введите количества
мест, отличных от нуля", vbCritical, "Ошибка!"
Exit Sub
End If
i = Selection.Row
Cells(i, 2).Value =
CStr(txt1.Text)
Cells(i, 3).Value =
CStr(txt2.Text)
Cells(i, 4).Value =
CStr(txt3.Text)
Cells(i, 6).Value =
DTPicker1.Value
Cells(i, 7).Value =
CStr(txt5.Text)
Cells(i, 8).Value =
CStr(TextBox2.Text)
If obm.Value = True
Then Cells(i, 5).Value = "Муж"
If obj.Value = True
Then Cells(i, 5).Value = "Жен"
If chb1.Value = True
Then
Cells(i, 14).Value
= "Оплачено"
Else
Cells(i, 14).Value
= "Не оплачено"
End If
If chb2.Value = True
Then
Cells(i, 15).Value
= "Сдано"
Else
Cells(i, 15).Value
= "Не сдано"
End If
If chb3.Value = True
Then
Cells(i, 12).Value
= "Да"
Else
Cells(i, 12).Value
= "Нет"
End If
Cells(i, 13).Value =
CStr(txt6.Text & ", " & txt7.Text)
Cells(i, 10).Value =
CStr(ComboBox3.Value)
Cells(i, 9).Value =
CStr(ComboBox2.Value)
Cells(i, 11).Value = CStr(ComboBox1.Value)
var1 = TextBox8.Text *
TextBox5.Text
var2 = TextBox9.Text *
TextBox6.Text
var3 = TextBox7.Text *
(CInt(TextBox8.Text) + CInt(TextBox9.Text))
Cells(i, 18).Value =
var1 + var2 + var3
колвз = TextBox8.Text
колдт = TextBox9.Text
Cells(i, 16).Value =
TextBox8.Text
Cells(i, 17).Value =
TextBox9.Text
If TextBox3.Text =
"0" Or TextBox4.Text = "0" Then
Exit Sub
End If
rowneed = Selection.Row
i = 3
Do
i = i + 1
Loop While Workbooks("Main.xls").Worksheets("Заказы").Cells(i,
1).Value <> ""
If Cells(4, 1).Value =
"" Then
num = 1
Else
num =
Workbooks("Main.xls").Worksheets("Заказы").Cells(i - 1,
1).Value + 1
End If
With
Workbooks("Main.xls")
.Worksheets("ВыхФорма").Unprotect
Password:="list"
.Worksheets("ВыхФорма").Cells(3, 2).Value =
.Worksheets("Заказы").Cells(rowneed, 1).Value
.Worksheets("ВыхФорма").Cells(4, 2).Value =
.Worksheets("Заказы").Cells(rowneed, 2).Value
.Worksheets("ВыхФорма").Cells(5, 2).Value =
.Worksheets("Заказы").Cells(rowneed, 3).Value
.Worksheets("ВыхФорма").Cells(6, 2).Value =
.Worksheets("Заказы").Cells(rowneed, 4).Value
.Worksheets("ВыхФорма").Cells(7, 2).Value =
.Worksheets("Заказы").Cells(rowneed, 5).Value
.Worksheets("ВыхФорма").Cells(8, 2).Value =
.Worksheets("Заказы").Cells(rowneed, 6).Value
.Worksheets("ВыхФорма").Cells(9, 2).Value =
.Worksheets("Заказы").Cells(rowneed, 7).Value
.Worksheets("ВыхФорма").Cells(10, 2).Value =
.Worksheets("Заказы").Cells(rowneed, 8).Value
.Worksheets("ВыхФорма").Cells(11, 2).Value =
.Worksheets("Заказы").Cells(rowneed, 9).Value
.Worksheets("ВыхФорма").Cells(12, 2).Value =
.Worksheets("Заказы").Cells(rowneed, 10).Value
.Worksheets("ВыхФорма").Cells(13, 2).Value =
.Worksheets("Заказы").Cells(rowneed, 11).Value
.Worksheets("ВыхФорма").Cells(14, 2).Value =
.Worksheets("Заказы").Cells(rowneed, 12).Value
.Worksheets("ВыхФорма").Cells(15, 2).Value =
.Worksheets("Заказы").Cells(rowneed, 13).Value
.Worksheets("ВыхФорма").Cells(16, 2).Value =
.Worksheets("Заказы").Cells(rowneed, 14).Value
.Worksheets("ВыхФорма").Cells(17, 2).Value =
.Worksheets("Заказы").Cells(rowneed, 15).Value
.Worksheets("ВыхФорма").Cells(18,
2).Value = .Worksheets("Заказы").Cells(rowneed, 16).Value
.Worksheets("ВыхФорма").Cells(19, 2).Value =
.Worksheets("Заказы").Cells(rowneed, 17).Value
.Worksheets("ВыхФорма").Cells(20, 2).Value = .Worksheets("Заказы").Cells(rowneed,
18).Value
.Worksheets("ВыхФорма").Activate
'.Worksheets("ВыхФорма").Protect Password:="list",
DrawingObjects:=True, Contents:=True, Scenarios:=True, _
AllowFormattingCells:=True, AllowFormattingColumns:=True, AllowFormattingRows:=True
End With
Me.HideSubSub
UserForm_Activate()
ActiveSheet.Unprotect
Password:="list"SubSub UserForm_Deactivate()
ActiveSheet.Protect
Password:="list"SubSub UserForm_Initialize()
txt6.MaxLength = 4
txt7.MaxLength = 6
DTPicker1.MaxDate = Now
For Each Sheet In
Workbooks("Firms").Worksheets
If Sheet.Name
<> "1" Then
ComboBox2.AddItem Sheet.Name
End If
Next Sheet
TextBox3.Text =
""
TextBox4.Text =
""
TextBox5.Text =
""
TextBox6.Text =
""
TextBox7.Text =
""
TextBox10.Text =
""SubSub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If Cancel = 0 Then ex =
0Sub
//Workbook(“Main.xls”) Форма Main
Private Sub CommandButton18_Click()
Me.Hide
Workbooks("Main.xls").Worksheets("ПоискПутевки").Activate
i = 4
Do
If i = 4 And
Cells(i, 1).Value = "" Then Exit Do
i = i + 1
Loop While Cells(i,
1).Value <> ""
Range(Cells(4, 1),
Cells(i, 12)).Delete
Find.ShowSubSub
CommandButton10_Click()
Me.Hide
NewZaSubSub
CommandButton13_Click()
Me.Hide
EditZaSubSub
CommandButton16_Click()
Me.Hide
DelZaSubSub
CommandButton17_Click()
Dim sav As Integer
If
Workbooks("Firms.xls").Saved = False Or
Workbooks("Main.xls").Saved = False Then
sav =
MsgBox("Сохранить и выйти?", vbYesNo + vbInformation,
"Внимание!")
If sav = vbNo Then
Exit Sub
If sav = vbYes Then
Workbooks("Firms.xls").Save
Workbooks("Main.xls").Save
Application.Quit
End If
End IfSubSub
CommandButton3_Click()
Workbooks("Firms.xls").Activate
Workbooks("Firms.xls").Worksheets("1").Activate
Me.HideSubSub
CommandButton4_Click()
Me.Hide
Workbooks("Main.xls").Worksheets("СписокФирм").ActivateSubSub
CommandButton5_Click()
Workbooks("Main.xls").Worksheets("Заказы").Activate
Me.HideSubSub
CommandButton6_Click()
Workbooks("Main.xls").Worksheets("ПоискПутевки").Activate
Me.HideSubSub
CommandButton7_Click()
Application.QuitSubSub
UserForm_Activate()
Workbooks("Main.xls").Worksheets("1").Activate
Caption = Space(95)
& "Главное меню" & Space(75)Sub
//Workbook(“Main.xls”)
Module1
Public ex As Integerколвз
As Double, колдт As DoubleОформить(nrow, max)
'Workbooks("Firms").Unprotect Password:="Firms1"
'ActiveSheet.Unprotect
Password:="list"
Range(Cells(nrow, 1),
Cells(nrow, max)).Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment
= xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit =
False
.ReadingOrder =
xlContext
.MergeCells = False
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With
Selection.Borders(xlEdgeLeft)
.LineStyle =
xlContinuous
.Weight = xlMedium
.ColorIndex =
xlAutomatic
End With
With
Selection.Borders(xlEdgeTop)
.LineStyle =
xlContinuous
.Weight = xlMedium
.ColorIndex =
xlAutomatic
End With
With
Selection.Borders(xlEdgeBottom)
.LineStyle =
xlContinuous
.Weight = xlMedium
.ColorIndex =
xlAutomatic
End With
With
Selection.Borders(xlEdgeRight)
.LineStyle =
xlContinuous
.Weight = xlMedium
.ColorIndex =
xlAutomatic
End With
With
Selection.Borders(xlInsideVertical)
.LineStyle =
xlContinuous
.Weight = xlThin
.ColorIndex =
xlAutomatic
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment
= xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit =
False
.ReadingOrder =
xlContext
.MergeCells = False
End With
With Selection.Font
.FontStyle =
"полужирный"
.Size = 8
.Strikethrough =
False
.Superscript =
False
.Subscript = False
.OutlineFont =
False
.Shadow = False
End WithSubNewZa()
ex = 1
Workbooks("Main.xls").Worksheets("Заказы").Activate
i = 3
Do
i = i + 1
Loop While Cells(i,
1).Value <> ""
If Cells(4, 1).Value =
"" Then
num = 1
Else
num = Cells(i - 1,
1).Value + 1
End If
Range(Cells(i, 1),
Cells(i, 18)).Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment
= xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit =
False
.ReadingOrder =
xlContext
.MergeCells = False
End With
With Selection.Font
.Name = "Arial
Cyr"
.FontStyle =
"полужирный"
.Size = 8
.Strikethrough =
False
.Superscript =
False
.Subscript = False
.OutlineFont =
False
.Shadow = False
.Underline =
xlUnderlineStyleNone
.ColorIndex =
xlAutomatic
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With
Selection.Borders(xlEdgeLeft)
.LineStyle =
xlContinuous
.Weight = xlMedium
.ColorIndex =
xlAutomatic
End With
With
Selection.Borders(xlEdgeTop)
.LineStyle =
xlContinuous
.Weight = xlMedium
.ColorIndex =
xlAutomatic
End With
With
Selection.Borders(xlEdgeBottom)
.LineStyle =
xlContinuous
.Weight = xlMedium
.ColorIndex =
xlAutomatic
End With
With
Selection.Borders(xlEdgeRight)
.LineStyle =
xlContinuous
.Weight = xlMedium
.ColorIndex =
xlAutomatic
End With
With
Selection.Borders(xlInsideVertical)
' .LineStyle =
xlContinuous
.Weight = xlThin
'.ColorIndex =
xlAutomatic
End With
Cells(i, 1).Value = num
With frmNewZakaz
.txt1.Text =
""
.txt2.Text =
""
.txt3.Text =
""
.DTPicker1.Value =
"01.01.1900"
.txt5.Text =
""
.TextBox2.Text =
""
.obm.Value = False
.obj.Value = False
.chb1.Value = False
.chb2.Value = False
.chb3.Value = False
.txt6.Text =
""
.txt7.Text =
""
.txt6.Enabled =
False
.txt7.Enabled =
False
.TextBox3.Text =
""
.TextBox4.Text =
""
.TextBox5.Text =
""
.TextBox6.Text =
""
.TextBox7.Text =
""
.TextBox8.Text =
""
.TextBox9.Text =
""
.TextBox10.Text =
""
.TextBox11.Text =
""
.ComboBox1.Value =
""
.ComboBox2.Value =
""
.ComboBox3.Value =
""
End With
frmNewZakaz.Show
If ex = 0 Then
Selection.Delete
Exit Sub
End If
Workbooks("Firms").Unprotect Password:="Firms1"
ActiveSheet.Unprotect
Password:="list"
i = 6
Str1 = i
With
Workbooks("Firms.xls").Worksheets(frmNewZakaz.ComboBox2.Value)
.Unprotect
Password:="list"
num = .Index
ie =
.Range("End" & num).Row
For ib =
.Range("Beg" & num).Row + 1 To ie
If
CStr(.Cells(ib, 1).Value) = frmNewZakaz.ComboBox3.Value And .Cells(ib,
1).MergeCells = True Then
Str1 =
.Cells(ib, 1).Row
Exit For
End If
Next ib
For Str1 =
.Cells(ib, 1).Row To ie
If
CStr(.Cells(Str1, 1).Value) = frmNewZakaz.ComboBox1.Value And .Cells(Str1,
1).MergeCells = False Then
.Cells(Str1, 2) = .Cells(Str1, 2) - CInt(frmNewZakaz.TextBox8.Text)
.Cells(Str1, 4) = .Cells(Str1, 4) - CInt(frmNewZakaz.TextBox9.Text)
Exit For
End If
Next Str1
' .Protect
Password:="list", DrawingObjects:=True, Contents:=True,
Scenarios:=True, _
AllowFormattingCells:=True, AllowFormattingColumns:=True,
AllowFormattingRows:=True
End With
' ActiveSheet.Protect
Password:="list", DrawingObjects:=True, Contents:=True,
Scenarios:=True, _
AllowFormattingCells:=True, AllowFormattingColumns:=True,
AllowFormattingRows:=True
'
Workbooks("Firms").Protect Password:="Firms1"SubEditZa()
Workbooks("Main.xls").Worksheets("Заказы").Activate
If Cells(4, 1) =
"" Then
MsgBox "Нечего
редактировать.", vbCritical, "Ошибка!"
Exit Sub
End If
Kol_Prstr2 = 3
Kol_Prstr = 4
Do
flag = 0
Workbooks("Main").Worksheets("Заказы").Activate
Строка = InputBox("Введите номер
заказа, который хотите изменить: ", _
"Ввод номера
заказа")
If Строка = "" Then Exit Sub
If Строка < 0 Or Строка = 0 Then
MsgBox "Нет такого номера
заказа в базе.", vbCritical, "Ошибка!"
flag = 1
End If
If
IsNumeric(Строка) = False Then
MsgBox "Введите номер
заказа в формате числа", vbCritical, "Ошибка!"
flag = 1
End If
Loop While flag = 1
i = 3
flaj = 0
Do
i = i + 1
If Cells(i,
1).Value = CInt(Строка) Then
flaj = 1
Exit Do
End If
Loop While Cells(i,
1).Value <> ""
If flaj = 0 Then
MsgBox "В базе нет такого
номера заказа", vbCritical, "Ошибка!"
Exit Sub
End If
ex = 1
Workbooks("Firms").Unprotect Password:="Firms1"
ActiveSheet.Unprotect
Password:="list"
Range(Cells(i, 1),
Cells(i, 18)).Select
temp = i
With frmNewZakaz
.Caption =
"Редактирование заказа"
.txt1.Text =
Cells(temp, 2)
.txt2.Text =
Cells(temp, 3)
.txt3.Text =
Cells(temp, 4)
.DTPicker1.Value =
Cells(temp, 6)
.txt5.Text =
Cells(temp, 7)
.TextBox2.Text =
Cells(temp, 8)
If Cells(temp, 5) =
"Муж" Then .obm.Value = True
If Cells(temp, 5) =
"Жен" Then .obj.Value = True
If Cells(temp,
14).Value = "Оплачено" Then .chb1.Value = True
If Cells(temp,
15).Value = "Сдано" Then .chb2.Value = True
If Cells(temp,
12).Value = "Да" Then
.chb3.Value =
True
.txt6.Text =
Left(Cells(temp, 13), 4)
.txt7.Text =
Right(Cells(temp, 13), 6)
End If
.ComboBox2.Value =
Cells(temp, 9) 'фирма
.ComboBox3.Value =
Cells(temp, 10) 'страна
.ComboBox1.Value =
Cells(temp, 11) 'город
.TextBox8.Text =
Cells(temp, 16)
.TextBox9.Text =
Cells(temp, 17)
End With
i = 6
Str1 = i
tempoNe =
CStr(Cells(temp, 9).Value)
With
Workbooks("Firms.xls").Worksheets(CStr(Cells(temp, 9).Value))
.Unprotect
Password:="list"
num = .Index
ie =
.Range("End" & num).Row
For ib =
.Range("Beg" & num).Row + 1 To ie
If
CStr(.Cells(ib, 1).Value) =
Workbooks("Main.xls").Worksheets("Заказы").Cells(temp, 10)
_
And .Cells(ib,
1).MergeCells = True Then
StrNe1 =
.Cells(ib, 1).Row
Exit For
End If
Next ib
For StrNe1 =
.Cells(ib, 1).Row + 1 To ie
If
CStr(.Cells(StrNe1, 1).Value) =
Workbooks("Main.xls").Worksheets("Заказы").Cells(temp,
11).Value _
And
.Cells(StrNe1, 1).MergeCells = False Then
regvzr =
.Cells(StrNe1, 2) +
Workbooks("Main.xls").Worksheets("Заказы").Cells(temp, 16)
regdet =
.Cells(StrNe1, 4) +
Workbooks("Main.xls").Worksheets("Заказы").Cells(temp, 17)
Exit For
End If
' .Protect
Password:="list", DrawingObjects:=True, Contents:=True,
Scenarios:=True, _
AllowFormattingCells:=True, AllowFormattingColumns:=True,
AllowFormattingRows:=True
Next StrNe1
End With
frmNewZakaz.TextBox3 =
Workbooks("Firms.xls").Worksheets(CStr(Cells(temp,
9).Value)).Cells(StrNe1, 2)
frmNewZakaz.TextBox4 =
Workbooks("Firms.xls").Worksheets(CStr(Cells(temp,
9).Value)).Cells(StrNe1, 4)
frmNewZakaz.TextBox5 =
Workbooks("Firms.xls").Worksheets(CStr(Cells(temp, 9).Value)).Cells(StrNe1,
3)
frmNewZakaz.TextBox6 =
Workbooks("Firms.xls").Worksheets(CStr(Cells(temp,
9).Value)).Cells(StrNe1, 5)
frmNewZakaz.TextBox7 =
Workbooks("Firms.xls").Worksheets(CStr(Cells(temp,
9).Value)).Cells(StrNe1, 6)
frmNewZakaz.TextBox10 =
Workbooks("Firms.xls").Worksheets(CStr(Cells(temp,
9).Value)).Cells(StrNe1, 7)
frmNewZakaz.Show
If ex = 0 Then Exit Sub
With
Workbooks("Firms.xls").Worksheets(tempoNe)
.Cells(StrNe1, 2)
= regvzr
.Cells(StrNe1, 4) =
regdet
End With
With
Workbooks("Firms.xls").Worksheets(frmNewZakaz.ComboBox2.Value)
.Unprotect
Password:="list"
num = .Index
ie =
.Range("End" & num).Row
For ib =
.Range("Beg" & num).Row + 1 To ie
If CStr(.Cells(ib,
1).Value) = frmNewZakaz.ComboBox3.Value _
And .Cells(ib,
1).MergeCells = True Then
Str1 =
.Cells(ib, 1).Row
Exit For
Next ib
For Str1 =
.Cells(ib, 1).Row To ie
If
CStr(.Cells(Str1, 1).Value) = frmNewZakaz.ComboBox1.Value _
And
.Cells(Str1, 1).MergeCells = False Then
.Cells(Str1, 2).Value = .Cells(Str1, 2).Value _
-
CInt(Workbooks("Main.xls").Worksheets("Заказы").Cells(temp,
16))
.Cells(Str1, 4).Value = .Cells(Str1, 4).Value _
-
CInt(Workbooks("Main.xls").Worksheets("Заказы").Cells(temp,
17))
Exit For
End If
' .Protect
Password:="list", DrawingObjects:=True, Contents:=True,
Scenarios:=True, _
AllowFormattingCells:=True, AllowFormattingColumns:=True,
AllowFormattingRows:=True
Next Str1
End With
' ActiveSheet.Protect
Password:="list", DrawingObjects:=True, Contents:=True,
Scenarios:=True, _
AllowFormattingCells:=True, AllowFormattingColumns:=True,
AllowFormattingRows:=True
'
Workbooks("Firms").Protect Password:="Firms1"SubDelZa()
Workbooks("Main.xls").Worksheets("Заказы").Activate
If Cells(4, 1) =
"" Then
MsgBox "Нечего
удалять.", vbCritical, "Ошибка!"
Exit Sub
End If
Do
flag = 0
Workbooks("Main").Worksheets("Заказы").Activate
Строка =
InputBox("Введите номер заказа, который хотите удалить: ", _
"Ввод номера
заказа")
If Строка = "" Then Exit Sub
If Строка < 0 Or Строка = 0 Then
MsgBox "Нет такого номера
заказа в базе.", vbCritical, "Ошибка!"
flag = 1
End If
If
IsNumeric(Строка) = False Then
MsgBox "Введите номер
заказа в формате числа", vbCritical, "Ошибка!"
flag = 1
End If
Loop While flag = 1
i = 3
flaj = 0
Do
i = i + 1
If Cells(i,
1).Value = CInt(Строка) Then
flaj = 1
Exit Do
End If
Loop While Cells(i,
1).Value <> ""
If flaj = 0 Then
MsgBox "В базе нет такого
номера заказа", vbCritical, "Ошибка!"
Exit Sub
End If
Workbooks("Firms").Unprotect Password:="Firms1"
ActiveSheet.Unprotect
Password:="list"
Ответ =
MsgBox("Подтверждаете удаление заказа № " & Строка &
"?", vbInformation + vbYesNo, "Внимание!")
If Ответ = vbNo Then
Exit Sub
ex = 1
Range(Cells(i, 1),
Cells(i, 18)).Select
With Workbooks("Firms.xls").Worksheets(Workbooks("Main.xls").Worksheets("Заказы").Cells(i,
9).Value)
.Unprotect
Password:="list"
num = .Index
ie =
.Range("End" & num).Row
For ib =
.Range("Beg" & num).Row + 1 To ie
If
CStr(.Cells(ib, 1).Value) =
Workbooks("Main.xls").Worksheets("Заказы").Cells(i, 10) _
And .Cells(ib,
1).MergeCells = True Then
Str1 =
.Cells(ib, 1).Row
Exit For
End If
Next ib
For Str1 =
.Cells(ib, 1).Row To ie
If
CStr(.Cells(Str1, 1).Value) =
Workbooks("Main.xls").Worksheets("Заказы").Cells(i, 11) _
And
.Cells(Str1, 1).MergeCells = False Then
.Cells(Str1, 2) = .Cells(Str1, 2) +
CInt(Workbooks("Main.xls").Worksheets("Заказы").Cells(i,
16))
.Cells(Str1, 4) = .Cells(Str1, 4) +
CInt(Workbooks("Main.xls").Worksheets("Заказы").Cells(i,
17))
Exit For
End If
Next Str1
' .Protect
Password:="list", DrawingObjects:=True, Contents:=True,
Scenarios:=True, _
AllowFormattingCells:=True, AllowFormattingColumns:=True,
AllowFormattingRows:=True
End With
' ActiveSheet.Protect
Password:="list", DrawingObjects:=True, Contents:=True,
Scenarios:=True, _
AllowFormattingCells:=True, AllowFormattingColumns:=True,
AllowFormattingRows:=True
'
Workbooks("Firms").Protect
Password:="Firms1".DeleteSubMainS()
Workbooks("Main.xls").Worksheets("1").Activate
Main.ShowSubShowPut()
Workbooks("Main.xls").Worksheets("ПоискПутевки").Activate
i = 4
Do
If i = 4 And
Cells(i, 1).Value = "" Then Exit Do
i = i + 1
Loop While Cells(i,
1).Value <> ""
Range(Cells(4, 1),
Cells(i, 12)).Delete
Find.ShowSub
//Workbook(“Firms.xls”).Worksheets(“1”)
Private Sub
Worksheet_SelectionChange(ByVal Target As Range)
SubMain.ShowSub
//Workbook(“Firms.xls”)
Private Sub
Workbook_Open()
'
Workbooks("Firms").Protect Password:="Firms1"
MenuBars(xlWorksheet).Menus.Add Caption:="&Работа с фирмами",
Before:=10
MenuBars(xlWorksheet).Menus("&Работа с фирмами").MenuItems.Add _
Caption:="&Перейти в меню фирм", Before:=2,
OnAction:="SubMainS"
MenuBars(xlWorksheet).Menus("Работа с фирмами").MenuItems.AddMenu _
"Добавление"
MenuBars(xlWorksheet).Menus("Работа с
фирмами").MenuItems("Добавление").MenuItems.Add "Новую
фирму", OnAction:="NewFirmLo"
MenuBars(xlWorksheet).Menus("Работа с
фирмами").MenuItems("Добавление").MenuItems.Add "Путевку в
базу", OnAction:="NewPut"
MenuBars(xlWorksheet).Menus("Работа с фирмами").MenuItems.AddMenu _
"Редактирование"
MenuBars(xlWorksheet).Menus("Работа с
фирмами").MenuItems("Редактирование").MenuItems.Add "Данных
о фирме", OnAction:="EditFirm"
MenuBars(xlWorksheet).Menus("Работа
с фирмами").MenuItems("Редактирование").MenuItems.Add
"Путевку в базе", OnAction:="EditPut"
MenuBars(xlWorksheet).Menus("Работа с фирмами").MenuItems.AddMenu _
"Поиск/Переход"
MenuBars(xlWorksheet).Menus("Работа с фирмами").MenuItems("Поиск/Переход").MenuItems.Add
"Перейти на определенную фирму", OnAction:="ShowList"
MenuBars(xlWorksheet).Menus("Работа с
фирмами").MenuItems("Поиск/Переход").MenuItems.Add
"Выделить опред. город опред. страны", OnAction:="ShowCountry"
MenuBars(xlWorksheet).Menus("Работа с фирмами").MenuItems.AddMenu _
"Удаление"
MenuBars(xlWorksheet).Menus("Работа с
фирмами").MenuItems("Удаление").MenuItems.Add "Фирму из
базы", OnAction:="DeleteFirm"
MenuBars(xlWorksheet).Menus("Работа с
фирмами").MenuItems("Удаление").MenuItems.Add "Путевку из
базы", OnAction:="DeleteCoun"Sub
//Workbook(“Firms.xls”) Форма frmDelCoun
Private Sub
ComboBox2_Change()
k = 0
num =
Worksheets(ActiveSheet.Name).Index
ie =
Range("End" & num).Row
ComboBox3.Clear
For ib =
Range("Beg" & num).Row + 1 To ie
If ComboBox2.Value
= Cells(ib, 1).Value And Cells(ib, 1).MergeCells = True Then
k = Cells(ib,
1).Row
Exit For
End If
Next ib
k = k + 1
temp = k
Do While Cells(k,
1).MergeCells = False And k <> Range("End" & num).Row
ComboBox3.AddItem
Cells(k, 1).Value
k = k + 1
LoopSubSub
CommandButton1_Click()
num = ActiveSheet.Index
ie =
Range("End" & num).Row
If ie = 6 Then
MsgBox "Нет
стран для удаления!", vbCritical, "Ошибка"
Me.Hide
Exit Sub
End If
CommandButton1.Caption = "Удалить страну и
ее города - выбрано"
ComboBox1.Enabled
= True
CommandButton1.Enabled
= False
CommandButton2.Enabled
= False
CommandButton3.Enabled
= True
ComboBox3.Enabled =
False
ComboBox2.Enabled =
False
CommandButton4.Enabled
= False
num = ActiveSheet.Index
ie =
Range("End" & num).Row
For ib =
Range("Beg" & num).Row + 1 To ie
If Cells(ib, 1).MergeCells
= True Then
ComboBox1.AddItem Cells(ib, 1).Value
End If
Next ibSubSub
CommandButton2_Click()
num = ActiveSheet.Index
ie =
Range("End" & num).Row
If ie = 6 Then
MsgBox "Нет
стран для удаления!", vbCritical, "Ошибка"
Me.Hide
Exit Sub
End If
CommandButton2.Caption = "Удалить город
определенной страны-выбрано"
CommandButton1.Enabled
= False
CommandButton4.Enabled
= True
ComboBox1.Enabled =
False
ComboBox2.Enabled =
True
ComboBox3.Enabled =
True
CommandButton2.Enabled
= False
For ib =
Range("Beg" & num).Row + 1 To ie
If Cells(ib,
1).MergeCells = True Then
ComboBox2.AddItem Cells(ib, 1).Value
End If
Next ibSubSub
CommandButton3_Click()
num = ActiveSheet.Index
ie =
Range("End" & num).Row
If ie = 6 Then
MsgBox "Нет
стран для удаления!", vbCritical, "Ошибка"
Me.Hide
Exit Sub
End If
If ComboBox1.Value =
"" Then
MsgBox
"Выберите страну для удаления!", vbCritical, "Ошибка!"
Exit Sub
End If
flag = 0
For ib =
Range("Beg" & num).Row + 1 To ie
If Cells(ib,
1).Value = ComboBox1.Value And Cells(ib, 1).MergeCells = True Then flag = 1
Next ib
If flag = 0 Then
MsgBox "В базе
нет такой страны!", vbOKOnly, "Ошибка!"
Exit Sub
End If
For ib =
Range("Beg" & num).Row + 1 To ie
If Cells(ib,
1).Value = ComboBox1.Value And Cells(ib, 1).MergeCells = True Then
строка =
Cells(ib, 1).Row
Exit For
End If
Next ib
needStr = строка + 1
Do While Cells(needStr,
1).MergeCells = False And needStr <> ie
needStr = needStr +
1
Loop
Ответ =
MsgBox("Подтверждаете удаление страны (" & ComboBox1.Value &
") и всех ее городов?", vbInformation + vbYesNo,
"Внимание!")
If Ответ = vbYes Then
Range(Cells(строка,
1), Cells(needStr - 1, 10)).Delete
Me.Hide
Exit Sub
Else
Me.Hide
Exit Sub
End IfSubSub
CommandButton4_Click()
temp = 0
num = ActiveSheet.Index
ie =
Range("End" & num).Row
If ie = 6 Then
MsgBox "Нет
стран для удаления!", vbCritical, "Ошибка"
Me.Hide
Exit Sub
End If
If ComboBox2.Value =
"" Or ComboBox3.Value = "" Then
MsgBox "Выбраны не все
данные!", vbCritical, "Ошибка!"
Exit Sub
End If
flag = 0
For ib =
Range("Beg" & num).Row + 1 To ie
If Cells(ib,
1).Value = ComboBox2.Value And Cells(ib, 1).MergeCells = True Then flag = 1
Next ib
If flag = 0 Then
MsgBox "В базе
нет такой страны!", vbOKOnly, "Ошибка!"
Exit Sub
End If
For ib =
Range("Beg" & num).Row + 1 To ie
If Cells(ib, 1) =
ComboBox2.Value And Cells(ib, 1).MergeCells = True Then
temp = ib ' начало страны
Exit For
End If
Next ib
temp = temp + 1
flag2 = 0
Do While Cells(temp,
1).MergeCells = False And temp <> Range("End" & num).Row
If ComboBox3.Value
= Cells(temp, 1).Value Then
flag2 = 1
Exit Do
End If
temp = temp + 1
Loop
If flag2 = 0 Then
MsgBox "Нет такого города
для этой страны в списке...", vbOKOnly, "Ошибка!"
ComboBox2.Value
= ""
Exit Sub
End If
Range(Cells(temp, 1),
Cells(temp, 10)).Select
Ответ = MsgBox("Подтверждаете
удаление города (" & ComboBox3.Value _
& ") страны
(" & ComboBox2.Value & ")?", vbInformation + vbYesNo, "Внимание!")
If Ответ =
vbYes Then
Selection.Delete
Me.Hide
Exit Sub
Else
Me.Hide
Exit Sub
End If
Me.HideSubSub
UserForm_Activate()
Workbooks("Firms").Unprotect Password:="Firms1"
ActiveSheet.Unprotect
Password:="list"
ComboBox1.Clear
ComboBox2.Clear
ComboBox3.Clear
ComboBox1.Enabled =
False
ComboBox2.Enabled =
False
ComboBox3.Enabled =
False
CommandButton3.Enabled
= False
CommandButton4.Enabled
= False
CommandButton1.Enabled
= True
CommandButton2.Enabled
= TrueSubSub UserForm_Initialize()
Workbooks("Firms").Unprotect Password:="Firms1"
ActiveSheet.Unprotect
Password:="list"SubSub UserForm_QueryClose(Cancel As Integer,
CloseMode As Integer)
If Cancel = 0 Then ex =
0Sub
//Workbook(“Firms.xls”) Форма frmEditFirm
Option Compare Textptemp
As StringSub cmbOK_Click()
Dim SA(1 To 7) As
Integer
SA(1) =
InStr(txtNaim.Text, ":")
SA(2) =
InStr(txtNaim.Text, "/")
SA(3) =
InStr(txtNaim.Text, "\")
SA(4) =
InStr(txtNaim.Text, "?")
SA(5) =
InStr(txtNaim.Text, "*")
SA(6) =
InStr(txtNaim.Text, "[")
SA(7) =
InStr(txtNaim.Text, "]")
n = Len(txtNaim.Text)
For i = 1 To 7
If SA(i) > 0 Or
n > 31 Then
MsgBox "Имя должно быть не
более 31 знака. И не содержать символов : / \ ? * [ ]", vbOKOnly, "Ошибка!"
Exit Sub
End If
Next i
temp = ActiveSheet.Name
If txtNaim.Text =
"" Then
MsgBox "Наименование не
может быть пустым!", vbCritical, "Ошибка"
Exit Sub
End If
For Each Sheet In
Workbooks("Firms.xls").Worksheets
If Sheet.Name =
frmEditFirm.txtNaim.Text And Sheet.Name <> temp Then fl = 1
Next Sheet
If fl = 1 Then
MsgBox "В базе
имеется фирма с таким именем!", vbCritical, "Ошибка!"
Exit Sub
End If
Me.HideSubSub
UserForm_Activate()
Workbooks("Firms").Unprotect
Password:="Firms1"
ActiveSheet.Unprotect
Password:="list"
lblNaim.ControlTipText
= _
"Имя должно быть не
более 31 знака. И не содержать символов : / \ ? * [ ]"
End Sub
Private Sub
UserForm_Deactivate()
txtNaim.Text =
""
txtAdr.Text =
""
txtTel1.Text =
""
txtTel2.Text =
""
txtSite.Text =
""SubSub UserForm_Initialize()
Workbooks("Firms").Unprotect Password:="Firms1"
ActiveSheet.Unprotect
Password:="list"SubSub UserForm_QueryClose(Cancel As Integer,
CloseMode As Integer)
If Cancel = 0 Then ex =
0Sub
//Workbook(“Firms.xls”) Форма frmNewPut
Option Compare Texttemp As
IntegerSub CommandButton1_Click()
Label1.Enabled = True
Label2.Enabled = True
TextBox1.Enabled = True
TextBox2.Enabled = True
CommandButton4.Enabled
= False
CommandButton3.Enabled
= True
CommandButton1.Caption
= "Добавить путевку" &
Chr(13) & "(новая страна и город)-выбрано"
CommandButton2.Caption =
"Добавить путевку (новый город)"
ComboBox1.Enabled
= False
TextBox3.Enabled =
FalseSubSub CommandButton2_Click()
' новый город
num = ActiveSheet.Index
If
Range("End" & num).Row = 6 Then
MsgBox "В базе нет ни
одной страны...", vbOKOnly, "Ошибка!"
CommandButton1_Click
Exit Sub
End If
Label3.Enabled = True
Label4.Enabled = True
ComboBox1.Enabled =
True
TextBox2.Enabled =
False
TextBox3.Enabled = True
CommandButton3.Enabled
= False
CommandButton4.Enabled
= True
'
ComboBox1.MatchRequired = True
' ComboBox1.MatchEntry
= fmMatchEntryComplete
CommandButton2.Caption =
"Добавить путевку (новый город)-выбрано"
CommandButton1.Caption
= "Добавить путевку" & Chr(13) & "(новая страна и
город)"
num = ActiveSheet.Index
ie =
Range("End" & num).Row
For ib =
Range("Beg" & num).Row + 1 To ie
If Cells(ib,
1).MergeCells = True Then
ComboBox1.AddItem Cells(ib, 1).Value
End If
Next ibSubSub
CommandButton3_Click() ' новая страна и город
num = ActiveSheet.Index
ie =
Range("End" & num).Row
For ib =
Range("Beg" & num).Row + 1 To ie
If Cells(ib,
1).Value = TextBox1.Text And Cells(ib, 1).MergeCells = True Then
MsgBox "В базе
имеется такая страна для этой фирмы!", vbOKOnly, "Ошибка!"
TextBox1.Text =
""
Exit Sub
End If
Next ib
If TextBox1.Text =
"" Or TextBox2.Text = "" Then
MsgBox "Введите
необходимые поля ввода!", vbOKOnly, "Ошибка!"
Exit Sub
End If
Range("End"
& Worksheets(ActiveSheet.Name).Index).Select
Selection.EntireRow.Insert
Selection.EntireRow.Insert
ie =
Range("End" & num).Row
Range(Cells(ie - 2, 1),
Cells(ie - 1, 10)).Select
Selection.Interior.ColorIndex = xlNone
Range(Cells(ie - 2, 1),
Cells(ie - 2, 10)).Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment
= xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit =
False
.ReadingOrder =
xlContext
.MergeCells = False
End With
Selection.Merge
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With
Selection.Borders(xlEdgeLeft)
.LineStyle =
xlContinuous
.Weight = xlMedium
.ColorIndex =
xlAutomatic
End With
With
Selection.Borders(xlEdgeTop)
.LineStyle =
xlContinuous
.Weight = xlMedium
.ColorIndex =
xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle =
xlContinuous
.Weight = xlMedium
.ColorIndex =
xlAutomatic
End With
With
Selection.Borders(xlEdgeRight)
.LineStyle =
xlContinuous
.Weight = xlMedium
.ColorIndex =
xlAutomatic
End With
With
Selection.Borders(xlInsideVertical)
.LineStyle =
xlContinuous
.Weight = xlThin
.ColorIndex =
xlAutomatic
End With
Cells(ie - 2, 1).Value
= TextBox1.Text
Cells(ie - 1, 1).Value
= TextBox2.Text
Me.Hide
frmPInfo.Label1.Caption
= ActiveSheet.Name
frmPInfo.TextBox1.Text
= Cells(ie - 2, 1).Value
frmPInfo.TextBox2.Text
= Cells(ie - 1, 1).Value
ex = 1
frmPInfo.Show
With frmPInfo
If .TextBox5.Value
= "" Then .TextBox5.Value = 0
If .TextBox6.Value
= "" Then .TextBox6.Value = 0
If .TextBox7.Value
= "" Then .TextBox7.Value = 0
If .TextBox3.Value
= "" Then .TextBox3.Value = 0
If .TextBox4.Value
= "" Then .TextBox4.Value = 0
Cells(ie - 1,
3).Value = CDbl(.TextBox5.Text)
Cells(ie - 1,
5).Value = CDbl(.TextBox6.Text)
Cells(ie - 1,
6).Value = CDbl(.TextBox7.Text)
Cells(ie - 1,
2).Value = CInt(.TextBox3.Text)
Cells(ie - 1,
4).Value = CInt(.TextBox4.Text)
Cells(ie - 1,
8).Value = CStr(.TextBox8.Text)
Cells(ie - 1,
10).Value = CStr(.TextBox9.Text)
If
frmPInfo.OptionButton1 = True Then
Cells(ie - 1,
7).Value = CInt(7)
End If
If
frmPInfo.OptionButton2 = True Then
Cells(ie - 1,
7).Value = CInt(14)
End If
If
frmPInfo.OptionButton3 = True Then
Cells(ie - 1,
7).Value = CInt(21)
End If
If
frmPInfo.OptionButton4 = True Then
Cells(ie - 1,
9).Value = CInt(1)
End If
If
frmPInfo.OptionButton5 = True Then
Cells(ie - 1,
9).Value = CInt(5)
End If
If
frmPInfo.OptionButton6 = True Then
Cells(ie - 1,
9).Value = CInt(2)
End If
If
frmPInfo.OptionButton7 = True Then
Cells(ie - 1,
9).Value = CInt(3)
End If
If
frmPInfo.OptionButton8 = True Then
Cells(ie - 1,
9).Value = CInt(4)
End If
End With
If ex = 0 Then Exit Sub
With frmPInfo
.TextBox5.Value =
""
.TextBox6.Text =
""
.TextBox7.Text =
""
.TextBox3.Text =
""
.TextBox4.Text =
""
.TextBox8.Text =
""
.TextBox9.Text =
""
.OptionButton1 =
False
.OptionButton2 =
False
.OptionButton3 =
False
.OptionButton4 =
False
.OptionButton5 =
False
.OptionButton6 =
False
.OptionButton7 =
False
.OptionButton8 =
False
End WithSubSub
CommandButton4_Click() ' новый город
temp = 0
temp2 = 0
num = ActiveSheet.Index
ie =
Range("End" & num).Row
flag = 0
For ib =
Range("Beg" & num).Row + 1 To ie
If CStr(Cells(ib,
1).Value) = ComboBox1.Value And Cells(ib, 1).MergeCells = True Then flag = 1
Next ib
If flag = 0 Then
MsgBox "В базе нет такой страны!",
vbOKOnly, "Ошибка!"
Exit Sub
End If
If TextBox3.Text =
"" Then
MsgBox "Введите
необходимые поля ввода!", vbOKOnly, "Ошибка!"
Exit Sub
End If
For ib =
Range("Beg" & num).Row + 1 To ie
If Cells(ib, 1) =
ComboBox1.Value And Cells(ib, 1).MergeCells = True Then
temp = ib ' начало страны
Exit For
End If
Next ib
temp2 = temp
temp = temp + 1
Do While Cells(temp,
1).MergeCells = False And temp <> Range("End" & num).Row
If Cells(temp,
1).Value = TextBox3.Text Then
MsgBox "В базе
имеется город для выбранной страны!", vbOKOnly, "Ошибка!"
TextBox3.Text =
""
Exit Sub
End If
temp = temp + 1
Loop
Cells(temp2 + 1,
1).Select
Selection.EntireRow.Insert
Cells(temp2 + 1,
1).Value = TextBox3.Text
Range(Cells(temp2 + 1,
1), Cells(temp2 + 1, 10)).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With
Selection.Borders(xlEdgeLeft)
.LineStyle =
xlContinuous
.Weight = xlMedium
.ColorIndex =
xlAutomatic
End With
With
Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex =
xlAutomatic
End With
With
Selection.Borders(xlEdgeBottom)
.LineStyle =
xlContinuous
.Weight = xlThin
.ColorIndex =
xlAutomatic
End With
With
Selection.Borders(xlEdgeRight)
.LineStyle =
xlContinuous
.Weight = xlMedium
.ColorIndex =
xlAutomatic
End With
With
Selection.Borders(xlInsideVertical)
.LineStyle =
xlContinuous
.Weight = xlThin
.ColorIndex =
xlAutomatic
End With
Me.Hide
frmPInfo.Label1.Caption
= ActiveSheet.Name
frmPInfo.TextBox1.Text
= frmNewPut.ComboBox1.Value
frmPInfo.TextBox2.Text
= frmNewPut.TextBox3.Text
ex = 1
frmPInfo.Show
With frmPInfo
If .TextBox5.Value
= "" Then .TextBox5.Value = 0
If .TextBox6.Value
= "" Then .TextBox6.Value = 0
If .TextBox7.Value
= "" Then .TextBox7.Value = 0
If .TextBox3.Value
= "" Then .TextBox3.Value = 0
If .TextBox4.Value
= "" Then .TextBox4.Value = 0
Cells(temp2 + 1, 3).Value
= CDbl(.TextBox5.Value)
Cells(temp2 + 1,
5).Value = CDbl(.TextBox6.Text)
Cells(temp2 + 1,
6).Value = CDbl(.TextBox7.Text)
Cells(temp2 + 1,
2).Value = CInt(.TextBox3.Text)
Cells(temp2 + 1,
4).Value = CInt(.TextBox4.Text)
Cells(temp2 + 1,
8).Value = CStr(.TextBox8.Text)
Cells(temp2 + 1,
10).Value = CStr(.TextBox9.Text)
If .OptionButton1 =
True Then
Cells(temp2 +
1, 7).Value = CInt(7)
End If
If .OptionButton2 =
True Then
Cells(temp2 +
1, 7).Value = CInt(14)
End If
If .OptionButton3 =
True Then
Cells(temp2 +
1, 7).Value = CInt(21)
End If
If .OptionButton4 =
True Then
Cells(temp2 +
1, 9).Value = CInt(1)
End If
If .OptionButton5 =
True Then
Cells(temp2 +
1, 9).Value = CInt(5)
End If
If .OptionButton6 =
True Then
Cells(temp2 +
1, 9).Value = CInt(2)
End If
If .OptionButton7 =
True Then
Cells(temp2 +
1, 9).Value = CInt(3)
End If
If .OptionButton8 =
True Then
Cells(temp2 +
1, 9).Value = CInt(4)
End If
End With
If ex = 0 Then Exit Sub
With frmPInfo
.TextBox5.Value =
""
.TextBox6.Text =
""
.TextBox7.Text =
""
.TextBox3.Text =
""
.TextBox4.Text =
""
.TextBox8.Text =
""
.TextBox9.Text =
""
.OptionButton1 =
False
.OptionButton2 =
False
.OptionButton3 =
False
.OptionButton4 =
False
.OptionButton5 =
False
.OptionButton6 =
False
.OptionButton7 =
False
.OptionButton8 =
False
End WithSubSub
UserForm_Activate()
Workbooks("Firms").Unprotect Password:="Firms1"
ActiveSheet.Unprotect
Password:="list"
TextBox1.Value =
""
TextBox2.Value =
""
ComboBox1.Clear
TextBox3.Value =
""
CommandButton3.Enabled
= False
CommandButton4.Enabled
= False
Label1.Enabled = False
Label2.Enabled = False
TextBox1.Enabled = False
TextBox2.Enabled =
False
Label3.Enabled = False
Label4.Enabled = False
ComboBox1.Enabled =
False
TextBox3.Enabled =
False
CommandButton1.Caption =
"Добавить путевку" & Chr(13) & "(новая страна и
город)"
CommandButton2.Caption
= "Добавить путевку (новый город)"
CommandButton1.Enabled
= True
CommandButton2.Enabled
= TrueSubSub UserForm_Initialize()
Workbooks("Firms").Unprotect Password:="Firms1"
ActiveSheet.Unprotect
Password:="list"Sub
//Workbook(“Firms.xls”) Форма frmPInfo
Option Compare TextSub
CommandButton1_Click()
' If TextBox3.Text =
"" Or TextBox4.Text = "" Or _
' TextBox5.Text =
"" Or TextBox6.Text = "" Or _
' TextBox7.Text =
"" Then
' MsgBox
"Введите расценки и количества мест !", vbOKOnly, "Ошибка!"
' Exit Sub
' End If
' If
OptionButton1.Value = False And OptionButton2.Value = False And _
' OptionButton3.Value =
False Then
' MsgBox
"Выберите длительность путевки!", vbOKOnly, "Ошибка!"
' Exit Sub
' End If
' If TextBox8.Text =
"" Then
' MsgBox
"Введите название отеля!", vbOKOnly, "Ошибка!"
' Exit Sub
' End If
' If
OptionButton4.Value = False And OptionButton5.Value = False And _
' OptionButton6.Value =
False And OptionButton7.Value = False And _
' OptionButton8.Value =
False Then
' MsgBox
"Выберите количество звезд отеля!", vbOKOnly, "Ошибка!"
' Exit Sub
' End If
If
IsNumeric(TextBox3.Text) = False And TextBox3.Text <> "" _
Or
IsNumeric(TextBox4.Text) = False And TextBox4.Text <> "" _
Or
IsNumeric(TextBox5.Text) = False And TextBox5.Text <> "" _
Or
IsNumeric(TextBox6.Text) = False And TextBox6.Text <> "" _
Or
IsNumeric(TextBox7.Text) = False And TextBox7.Text <> "" Then
MsgBox "Проверьте правильность
формата введенных данных", vbCritical + vbOKOnly, "Ошибка!"
Exit Sub
End If
Me.HideSubSub
UserForm_Activate()
Workbooks("Firms").Unprotect Password:="Firms1"
ActiveSheet.Unprotect
Password:="list"SubSub UserForm_QueryClose(Cancel As Integer,
CloseMode As Integer)
If Cancel = 0 Then ex =
0Sub
//Workbook(“Firms.xls”) Форма frmSelPut
Dim k, m As Integertemp As
Integernum As Integerie As Integer
Private Sub
ComboBox1_Change()
k = 0
num =
Worksheets(ActiveSheet.Name).Index
ie =
Range("End" & num).Row
ComboBox2.Clear
For ib =
Range("Beg" & num).Row + 1 To ie
If ComboBox1.Value
= CStr(Cells(ib, 1).Value) And Cells(ib, 1).MergeCells = True Then
k = Cells(ib,
1).Row
Exit For
End If
Next ib
k = k + 1
temp = k
Do While Cells(k,
1).MergeCells = False And k <> Range("End" & num).Row
ComboBox2.AddItem
Cells(k, 1).Value
k = k + 1
LoopSubSub
CommandButton5_Click()
If ComboBox1.Value =
"" And ComboBox2.Value = "" Then
MsgBox "Выберите
страну/город. Определитесь уже.", vbCritical, "Ошибка!"
Exit Sub
End If
If ComboBox2.Value =
"" And ComboBox1.Value <> "" Then
MsgBox "Выберите город.",
vbCritical, "Ошибка!"
Exit Sub
End If
If ComboBox1.Value =
"" And ComboBox2.Value <> "" Then
Exit Sub
End If
If ComboBox1.Value
<> "" And ComboBox2.Value <> "" Then
flag = 0
For ib =
Range("Beg" & num).Row + 1 To ie
If
CStr(Cells(ib, 1).Value) = ComboBox1.Value And Cells(ib, 1).MergeCells = True
Then
flag = 1
Exit For
End If
Next ib
If flag = 0 Then
MsgBox
"Нет такой страны в списке...", vbOKOnly, "Ошибка!"
ComboBox1.Value
= ""
ComboBox2.Value
= ""
Exit Sub
End If
flag2 = 0
Do While
Cells(temp, 1).MergeCells = False And temp <> Range("End" &
num).Row
If
ComboBox2.Value = CStr(Cells(temp, 1).Value) Then
flag2 = 1
Exit Do
End If
temp = temp + 1
Loop
If flag2 = 0 Then
MsgBox
"Нет такого города для этой страны в списке...", vbOKOnly,
"Ошибка!"
ComboBox2.Value
= ""
Exit Sub
End If
Range(Cells(temp,
1), Cells(temp, 10)).Select
Me.Hide
End If
If ComboBox1.Value
<> "" And ComboBox2.Value = "" Then
For ib =
Range("Beg" & num).Row + 1 To ie
If
CStr(Cells(ib, 1).Value) = ComboBox1.Value And Cells(ib, 1).MergeCells = True
Then
NR =
Cells(ib, 1).Row
flag = 1
Exit For
End If
Next ib
If flag = 0 Then
MsgBox
"Нет такой страны в списке...", vbOKOnly, "Ошибка!"
ComboBox1.Value
= ""
ComboBox2.Value
= ""
Exit Sub
End If
Worksheets(ActiveSheet.Name).Cells(NR, 1).Select
Me.Hide
End IfSubSub
UserForm_Activate()
Workbooks("Firms").Unprotect Password:="Firms1"
ActiveSheet.Unprotect
Password:="list"
ComboBox1.Clear
ComboBox2.Clear
num =
Worksheets(ActiveSheet.Name).Index
ie =
Range("End" & num).Row
For ib =
Range("Beg" & num).Row + 1 To ie
If Cells(ib,
1).MergeCells = True Then
ComboBox1.AddItem Cells(ib, 1).Value
End If
Next ibSubSub
UserForm_Deactivate()
ComboBox1.Clear
ComboBox2.ClearSubSub
UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If Cancel = 0 Then ex =
0Sub
//Workbook(“Firms.xls”) Форма listFirm
Private Sub
CommandButton1_Click()
flag = 0
For Each Sheet In
Workbooks("Firms.xls").Worksheets
If Sheet.Name =
ComboBox1.Value Then flag = 1
Next Sheet
If flag = 0 Then
MsgBox "Нет такой фирмы в базе...",
vbCritical, "Ошибка!"
Exit Sub
End If
Me.Hide
Workbooks("Firms.xls").Worksheets(ComboBox1.Value).ActivateSubSub
UserForm_Activate()
ComboBox1.Clear
For Each Sheet In
Workbooks("Firms.xls").Worksheets
If Sheet.Name
<> "1" Then
ComboBox1.AddItem Sheet.Name
End If
Next SheetSubSub
UserForm_Deactivate()
ComboBox1.ClearSubSub
UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If Cancel = 0 Then ex =
0Sub
//Workbook(“Firms.xls”) Форма NewFirm
Option Compare TextSub
cmbOK_Click()
Dim SA(1 To 7) As
Integer
SA(1) =
InStr(txtNaim.Text, ":")
SA(2) =
InStr(txtNaim.Text, "/")
SA(3) =
InStr(txtNaim.Text, "\")
SA(4) =
InStr(txtNaim.Text, "?")
SA(5) =
InStr(txtNaim.Text, "*")
SA(6) =
InStr(txtNaim.Text, "[")
SA(7) =
InStr(txtNaim.Text, "]")
n = Len(txtNaim.Text)
For i = 1 To 7
If SA(i) > 0 Or
n > 31 Then
MsgBox "Имя должно быть
не более 31 знака." & Chr(13) & "И не содержать символов : /
\ ? *
[ ]", vbCritical, "Ошибка!"
Exit Sub
End If
Next i
If txtNaim.Text =
"" Then
MsgBox "Наименование
не может быть пустым!", vbCritical, "Ошибка"
Worksheets("1").Activate
Exit Sub
End If
For Each Sheet In
ActiveWorkbook.Sheets
If Sheet.Name =
txtNaim.Text Then
MsgBox "Страница с
таким именем уже существует!", vbCritical, "Ошибка"
Exit Sub
End If
Next Sheet
Workbooks("Firms").Unprotect Password:="Firms1"
Workbooks("Firms").Activate
Sheets.Add.Move
after:=Worksheets(Worksheets.Count)
Range("A1:E1").Select
Selection.HorizontalAlignment = xlCenter
Selection.VerticalAlignment = xlBottom
Selection.NumberFormat
= "General"
With Selection.Font
.Name =
"Arial"
.FontStyle = "полужирный"
.Size = 8
.Strikethrough =
False
.Superscript =
False
.Subscript = False
.OutlineFont =
False
.Shadow = False
.Underline =
xlUnderlineStyleNone
.ColorIndex =
xlAutomatic
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With
Selection.Borders(xlEdgeLeft)
.LineStyle =
xlContinuous
.Weight = xlThin
.ColorIndex =
xlAutomatic
End With
With
Selection.Borders(xlEdgeTop)
.LineStyle =
xlContinuous
.Weight = xlThin
.ColorIndex =
xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle =
xlContinuous
.Weight = xlThin
.ColorIndex =
xlAutomatic
End With
With
Selection.Borders(xlEdgeRight)
.LineStyle =
xlContinuous
.Weight = xlThin
.ColorIndex =
xlAutomatic
End With
With
Selection.Borders(xlInsideVertical)
.LineStyle =
xlContinuous
.Weight = xlThin
.ColorIndex =
xlAutomatic
End With
With Selection.Interior
.ColorIndex = 39
.Pattern = xlSolid
.PatternColorIndex
= xlAutomatic
End With
Range("A1").Value = txtNaim.Text
Range("B1").Value = txtAdr.Text
Range("C1").Value = txtTel1.Text
Range("D1").Value = txtTel2.Text
Range("E1").Value = txtSite.Text
Range("A1:E1").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment
= xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit =
False
.ReadingOrder =
xlContext
.MergeCells = False
End With
Range("A3:J3").Select
With Selection.Font
.Name =
"Arial"
.Size = 14
.Strikethrough =
False
.Superscript =
False
.Subscript = False
.OutlineFont =
False
.Shadow = False
.Underline =
xlUnderlineStyleNone
.ColorIndex =
xlAutomatic
End With
Selection.Font.Bold =
True
Selection.Font.Italic =
True
ActiveCell.FormulaR1C1
= "Путевки"
Range("A3:J3").Select
Range("B3").Activate
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment
= xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit =
False
.ReadingOrder =
xlContext
.MergeCells = False
End With
Selection.Merge
Module1.CreateTable
Range("A6").Select
ActiveWindow.FreezePanes = True
Range("A5").Name = "Beg" &
Worksheets(ActiveSheet.Name).Index
Range("A6").Name = "End" & Worksheets(ActiveSheet.Name).Index
Worksheets(Worksheets.Count).Name = txtNaim
Me.Hide
Range("E1").Select
Selection.Hyperlinks.Add Anchor:=Selection, Address:="http://" &
txtSite.Text
Columns("A:J").Select
Selection.ColumnWidth =
15.5
Range("A1").Select
' ActiveSheet.Protect
Password:="list", DrawingObjects:=True, Contents:=True,
Scenarios:=True, _
AllowFormattingCells:=True, AllowFormattingColumns:=True,
AllowFormattingRows:=True
'
Workbooks("Firms").Protect Password:="Firms1"SubSub
UserForm_Activate()
Workbooks("Firms").Unprotect Password:="Firms1"
ActiveSheet.Unprotect
Password:="list"
lblNaim.ControlTipText
= _
"Имя должно быть не
более 31 знака. И не содержать символов : / \ ? * [ ]"
txtNaim = ""
txtAdr =
""
txtTel1 = ""
txtTel2 = ""
txtSite =
""Sub
//Workbook(“Firms.xls”) Форма SubMain
Private Sub
CommandButton11_Click()
Me.Hide
ex = 1
listFirm.Show
If ex = 0 Then Exit Sub
ex = 1
EditFirm
If ex = 0 Then Exit
SubSubSub CommandButton12_Click()
Me.Hide
ex = 1
listFirm.Show
If ex = 0 Then Exit Sub
ex = 1
EditPut
If ex = 0 Then Exit
SubSubSub CommandButton14_Click()
Me.Hide
ex = 1
listFirm.Show
If ex = 0 Then Exit Sub
ex = 1
DeleteFirm
If ex = 0 Then Exit
SubSubSub CommandButton15_Click()
Me.Hide
ex = 1
listFirm.Show
If ex = 0 Then Exit Sub
ex = 1
DeleteCoun
If ex = 0 Then Exit
SubSubSub CommandButton17_Click()
Dim sav As Integer
If
Workbooks("Firms.xls").Saved = False Or
Workbooks("Main.xls").Saved = False Then
sav = MsgBox("Сохранить и выйти?",
vbYesNo + vbInformation, "Внимание!")
If sav = vbNo Then
Exit Sub
If sav = vbYes Then
Workbooks("Firms.xls").Save
Workbooks("Main.xls").Save
Application.Quit
End If
End IfSubSub
CommandButton18_Click()
Me.Hide
ShowListSubSub
CommandButton7_Click()
Workbooks("Firms.xls").Save
Workbooks("Main.xls").Save
Application.QuitSubSub
CommandButton8_Click()
Me.Hide
NewFirmLoSubSub
CommandButton9_Click()
Me.Hide
ex = 1
listFirm.Show
If ex = 0 Then Exit Sub
ex = 1
NewPut
If ex = 0 Then Exit
SubSubSub UserForm_Activate()
Workbooks("Main.xls").Worksheets("1").Activate
Caption = Space(80)
& "Меню работы с фирмами" &
Space(60)Sub
//Workbook(“Firms.xls”)
Module1
Public ex As
IntegerCompare TextCreateTable()
Range("A5").FormulaR1C1 = "Город"
Range("B5").FormulaR1C1 = "Кол-во своб.
мест (взр.)"
Range("C5").FormulaR1C1 = "Цена взр.
билета"
Range("D5").FormulaR1C1 = "Кол-во своб.
мест (дет.)"
Range("E5").FormulaR1C1 = "Цена дет.
билета"
Range("F5").FormulaR1C1 = "Цена
страховки"
Range("G5").FormulaR1C1 = "Длительность
путевки (дн.)"
Range("H5").FormulaR1C1
= "Отель"
Range("I5").FormulaR1C1 = "Кол-во звезд"
Range("J5").FormulaR1C1 = "Доп. Услуги"
Range("A5:J6").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment
= xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit =
False
.ReadingOrder =
xlContext
.MergeCells = False
End With
With Selection.Font
.Name =
"Arial"
.FontStyle =
"полужирный"
.Size = 8
.Strikethrough =
False
.Superscript =
False
.Subscript = False
.OutlineFont =
False
.Shadow = False
.Underline =
xlUnderlineStyleNone
.ColorIndex =
xlAutomatic
End With
Selection.Borders(xlDiagonalDown).LineStyle
= xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With
Selection.Borders(xlEdgeLeft)
.LineStyle =
xlContinuous
.Weight = xlMedium
.ColorIndex =
xlAutomatic
End With
With
Selection.Borders(xlEdgeTop)
.LineStyle =
xlContinuous
.Weight = xlMedium
.ColorIndex =
xlAutomatic
End With
With
Selection.Borders(xlEdgeBottom)
.LineStyle =
xlContinuous
.Weight = xlMedium
.ColorIndex =
xlAutomatic
End With
With
Selection.Borders(xlEdgeRight)
.LineStyle =
xlContinuous
.Weight = xlMedium
.ColorIndex =
xlAutomatic
End With
With
Selection.Borders(xlInsideVertical)
.LineStyle =
xlContinuous
.Weight = xlThin
.ColorIndex =
xlAutomatic
With
Selection.Borders(xlInsideHorizontal)
.LineStyle =
xlContinuous
.Weight = xlMedium
.ColorIndex =
xlAutomatic
End With
With Selection.Interior
.ColorIndex = 19
.Pattern = xlSolid
.PatternColorIndex
= xlAutomatic
End WithSubNewPut()
Workbooks("Firms").Unprotect Password:="Firms1"
ActiveSheet.Unprotect
Password:="list"
string1 =
"Firms.xls"
If ActiveSheet.Name = "1"
Or ActiveWorkbook.Name <> CStr(string1) Then
MsgBox "Выберите
(активируйте) лист в книге /Firms/, в который нужно внести изменения.", vbInformation, "Внимание!"
Exit Sub
End If
ex = 1
frmNewPut.Show
' ActiveSheet.Protect
Password:="list", DrawingObjects:=True, Contents:=True,
Scenarios:=True, _
AllowFormattingCells:=True, AllowFormattingColumns:=True,
AllowFormattingRows:=True
'
Workbooks("Firms").Protect Password:="Firms1"
If ex = 0 Then Exit
SubSubEditFirm()
Workbooks("Firms").Unprotect Password:="Firms1"
ActiveSheet.Unprotect
Password:="list"
fl = 0
string1 =
"Firms.xls"
If ActiveSheet.Name =
"1" Or ActiveWorkbook.Name <> CStr(string1) Then
MsgBox "Выберите (активируйте)
лист в книге /Firms/, в который нужно внести изменения.", vbInformation, "Внимание!"
Exit Sub
End If
frmEditFirm.txtNaim.Text = ActiveSheet.Range("A1").Value
frmEditFirm.txtAdr.Text
= ActiveSheet.Range("B1").Value
frmEditFirm.txtTel1.Text = ActiveSheet.Range("C1").Value
frmEditFirm.txtTel2.Text = ActiveSheet.Range("D1").Value
frmEditFirm.txtSite.Text = ActiveSheet.Range("E1").Value
ex = 1
frmEditFirm.Show
If ex = 0 Then Exit Sub
ActiveSheet.Range("A1").Value
= frmEditFirm.txtNaim.Text
ActiveSheet.Name =
CStr(frmEditFirm.txtNaim.Text)
ActiveSheet.Range("B1").Value = frmEditFirm.txtAdr.Text
ActiveSheet.Range("C1").Value = frmEditFirm.txtTel1.Text
ActiveSheet.Range("D1").Value = frmEditFirm.txtTel2.Text
ActiveSheet.Range("E1").Value = ""
ActiveSheet.Range("E1").Value = frmEditFirm.txtSite.Text
ActiveSheet.Range("E1").Hyperlinks.Add
Anchor:=ActiveSheet.Range("E1"), Address:="http://" &
frmEditFirm.txtSite.Text
' ActiveSheet.Protect
Password:="list", DrawingObjects:=True, Contents:=True,
Scenarios:=True, _
AllowFormattingCells:=True, AllowFormattingColumns:=True,
AllowFormattingRows:=True
'
Workbooks("Firms").Protect
Password:="Firms1"SubDeleteFirm()
Workbooks("Firms").Unprotect
Password:="Firms1"
ActiveSheet.Unprotect
Password:="list"
Application.DisplayAlerts = False
string1 =
"Firms.xls"
If ActiveSheet.Name =
"1" Or ActiveWorkbook.Name <> CStr(string1) Then
MsgBox "Выберите
(активируйте) лист в книге /Firms/, в который нужно внести изменения.", vbInformation, "Внимание!"
Exit Sub
End If
i = MsgBox("Удаляем фирму
(" & ActiveSheet.Name & ")?", vbInformation + vbOKCancel, "Внимание!")
If i = 1 Then
Workbooks("Firms").Unprotect Password:="Firms1"
ActiveSheet.Unprotect Password:="list"
x =
ActiveSheet.Index
ActiveSheet.Delete
For i = x To
Worksheets.Count
Names.Add
Name:="End" & i, RefersTo:=Worksheets(i).Range("End"
& i + 1), Visible:=True
Names.Add
Name:="Beg" & i, RefersTo:=Worksheets(i).Range("Beg"
& i + 1), Visible:=True
Next i
Application.DisplayAlerts = True
Else
Exit Sub
End If
' ActiveSheet.Protect
Password:="list", DrawingObjects:=True, Contents:=True,
Scenarios:=True, _
AllowFormattingCells:=True, AllowFormattingColumns:=True,
AllowFormattingRows:=True
'
Workbooks("Firms").Protect Password:="Firms1"SubSub
ShowList()
ex = 1
listFirm.Show
If ex = 0 Then Exit
SubSubNewFirmLo()
Workbooks("Firms").Unprotect Password:="Firms1"
ActiveSheet.Unprotect
Password:="list"
Workbooks("Firms").Worksheets("1").Activate
ex = 1
NewFirm.Show
If ex = 0 Then Exit Sub
' ActiveSheet.Protect
Password:="list", DrawingObjects:=True, Contents:=True,
Scenarios:=True, _
AllowFormattingCells:=True, AllowFormattingColumns:=True,
AllowFormattingRows:=True
'
Workbooks("Firms").Protect Password:="Firms1"SubEditPut()
Workbooks("Firms").Unprotect Password:="Firms1"
ActiveSheet.Unprotect
Password:="list"
string1 =
"Firms.xls"
If ActiveSheet.Name =
"1" Or ActiveWorkbook.Name <> CStr(string1) Then
MsgBox "Выберите
(активируйте) лист в книге /Firms/, в который нужно внести изменения.", vbInformation, "Внимание!"
Exit Sub
End If
ex = 1
num =
Workbooks("Firms.xls").ActiveSheet.Index
ie =
Workbooks("Firms.xls").ActiveSheet.Range("End" &
num).Row
If ie = 6 Then
MsgBox "В базе нет путевок
- нечего редактировать.", vbCritical, "Ошибка!"
Exit Sub
End If
frmSelPut.CommandButton5.Visible = True
frmSelPut.Show
If ex = 0 Then Exit Sub
ex = 1
temp = ActiveCell.Row
gorod = Cells(temp, 1)
i = temp
Do While Cells(i,
1).MergeCells = False
i = i - 1
Loop
frmPInfo.Label1.Caption
= ActiveSheet.Name
frmPInfo.TextBox1.Text
= Cells(i, 1).Value
frmPInfo.TextBox2.Text
= gorod
frmPInfo.TextBox3.Text
= Cells(temp, 2).Value
frmPInfo.TextBox5.Text
= Cells(temp, 3).Value
frmPInfo.TextBox4.Text
= Cells(temp, 4).Value
frmPInfo.TextBox6.Text
= Cells(temp, 5).Value
frmPInfo.TextBox7.Text
= Cells(temp, 6).Value
frmPInfo.TextBox8.Text
= Cells(temp, 8).Value
frmPInfo.TextBox9.Text
= Cells(temp, 10).Value
If Cells(temp, 7).Value
= 7 Then frmPInfo.OptionButton1 = True
If Cells(temp, 7).Value
= 14 Then frmPInfo.OptionButton2 = True
If Cells(temp, 7).Value
= 21 Then frmPInfo.OptionButton3 = True
If Cells(temp, 9).Value
= 1 Then frmPInfo.OptionButton4 = True
If Cells(temp, 9).Value
= 2 Then frmPInfo.OptionButton6 = True
If Cells(temp, 9).Value
= 3 Then frmPInfo.OptionButton7 = True
If Cells(temp, 9).Value
= 4 Then frmPInfo.OptionButton8 = True
If Cells(temp, 9).Value
= 5 Then frmPInfo.OptionButton5 = True
frmPInfo.Show
If ex = 0 Then Exit Sub
With frmPInfo
If .TextBox5.Value
= "" Then .TextBox5.Value = 0
If .TextBox6.Value
= "" Then .TextBox6.Value = 0
If .TextBox7.Value =
"" Then .TextBox7.Value = 0
If .TextBox3.Value
= "" Then .TextBox3.Value = 0
If .TextBox4.Value
= "" Then .TextBox4.Value = 0
Cells(temp,
3).Value = CDbl(.TextBox5.Value)
Cells(temp,
5).Value = CDbl(.TextBox6.Text)
Cells(temp,
6).Value = CDbl(.TextBox7.Text)
Cells(temp,
2).Value = CInt(.TextBox3.Text)
Cells(temp,
4).Value = CInt(.TextBox4.Text)
Cells(temp,
8).Value = CStr(.TextBox8.Text)
Cells(temp,
10).Value = CStr(.TextBox9.Text)
If .OptionButton1 =
True Then
Cells(temp,
7).Value = CInt(7)
End If
If .OptionButton2 =
True Then
Cells(temp,
7).Value = CInt(14)
End If
If .OptionButton3 =
True Then
Cells(temp,
7).Value = CInt(21)
End If
If .OptionButton4 =
True Then
Cells(temp,
9).Value = CInt(1)
End If
If .OptionButton5 =
True Then
Cells(temp,
9).Value = CInt(5)
End If
If .OptionButton6 =
True Then
Cells(temp,
9).Value = CInt(2)
End If
If .OptionButton7 =
True Then
Cells(temp,
9).Value = CInt(3)
End If
If .OptionButton8 =
True Then
Cells(temp,
9).Value = CInt(4)
End If
End With
frmPInfo.Label1.Caption
= ""
frmPInfo.TextBox1.Text
= ""
frmPInfo.TextBox2.Text
= ""
frmPInfo.TextBox3.Text
= ""
frmPInfo.TextBox4.Text
= ""
frmPInfo.TextBox5.Text
= ""
frmPInfo.TextBox6.Text
= ""
frmPInfo.TextBox7.Text
= ""
frmPInfo.TextBox8.Text
= ""
frmPInfo.TextBox9.Text
= ""
frmPInfo.OptionButton1
= False
frmPInfo.OptionButton2
= False
frmPInfo.OptionButton3
= False
frmPInfo.OptionButton4
= False
frmPInfo.OptionButton5
= False
frmPInfo.OptionButton6
= False
frmPInfo.OptionButton7
= False
frmPInfo.OptionButton8
= False
' ActiveSheet.Protect
Password:="list", DrawingObjects:=True, Contents:=True,
Scenarios:=True, _
AllowFormattingCells:=True, AllowFormattingColumns:=True, AllowFormattingRows:=True
'
Workbooks("Firms").Protect
Password:="Firms1"SubDeleteCoun()
Workbooks("Firms").Unprotect Password:="Firms1"
ActiveSheet.Unprotect
Password:="list"
string1 =
"Firms.xls"
If ActiveSheet.Name =
"1" Or ActiveWorkbook.Name <> CStr(string1) Then
MsgBox "Выберите
(активируйте) лист в книге /Firms/, в который нужно внести изменения.", vbInformation, "Внимание!"
Exit Sub
End If
num =
Workbooks("Firms.xls").ActiveSheet.Index
ie =
Workbooks("Firms.xls").ActiveSheet.Range("End" &
num).Row
If ie = 6 Then
MsgBox "В базе нет путевок
- нечего удалять.", vbCritical, "Ошибка!"
Exit Sub
End If
ex = 1
frmDelCoun.Show
If ex = 0 Then Exit Sub
' ActiveSheet.Protect
Password:="list", DrawingObjects:=True, Contents:=True,
Scenarios:=True, _
AllowFormattingCells:=True, AllowFormattingColumns:=True,
AllowFormattingRows:=True
'
Workbooks("Firms").Protect Password:="Firms1"
Range("A1").SelectSubShowCountry()
Workbooks("Firms").Unprotect Password:="Firms1"
ActiveSheet.Unprotect
Password:="list"
string1 =
"Firms.xls"
If ActiveSheet.Name =
"1" Or ActiveWorkbook.Name <> CStr(string1) Then
MsgBox "Выберите
(активируйте) лист в книге /Firms/, в который нужно внести изменения.", vbInformation, "Внимание!"
Exit Sub
End If
num =
Workbooks("Firms.xls").ActiveSheet.Index
ie =
Workbooks("Firms.xls").ActiveSheet.Range("End" &
num).Row
If ie = 6 Then
MsgBox "В базе нет путевок
- нечего искать.", vbCritical, "Ошибка!"
Exit Sub
End If
ex = 1
frmSelPut.Show
If ex = 0 Then Exit Sub
' ActiveSheet.Protect
Password:="list", DrawingObjects:=True, Contents:=True,
Scenarios:=True, _
AllowFormattingCells:=True, AllowFormattingColumns:=True,
AllowFormattingRows:=True
'
Workbooks("Firms").Protect Password:="Firms1"SubSubMainS()
Workbooks("Firms.xls").Worksheets("1").Activate
SubMain.Show