бесплатные рефераты

Рефераты

рефераты   Главная
рефераты   Финансовое право
рефераты   Финансовый менеджмент
      финансовая математика
рефераты   Финансы деньги кредит
рефераты   Французский
рефераты   Компьютерные сети
рефераты   Конституционное право
      зарубежныйх стран
рефераты   Конституционное право
      России
рефераты   Краткое содержание
      произведений
рефераты   Программирование
      компьютеры и кибернетика
рефераты   Производство и технологии
рефераты   Психология
рефераты   Разное
рефераты   Религия и мифология
рефераты   Трудовое право
рефераты   Туризм
рефераты   Уголовное право и процесс
рефераты   Управление
 
 
 

Автоматизация учета основных средств на предприятии

Рис.2.16 Взаимосвязи между объектами проекта.

К наиболее часто используемым визуальным элементам интерфейса относятся: для ввода, отображения и редактирования информации - текст (надпись), однострочный редактор, различные списки, таблицы; для запуска команд на выполнение - стандартные кнопки, кнопки с рисунком и кнопки быстрого доступа.

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

Таким образом, форма представляет собой компонент Delphi, служащий контейнером для всех других компонентов.

Перечень объектов в базе таковой:

Рабочие таблицы в базе:

АктыПриемки, АктыРемонта, АктыСписания, АктыСписанияТовары, ВнутренниеНакл, ВнутренниеНаклТовары, Должности, Инвентаризации, ИнвентаризацииТовары, ИнвентКарты, Исполнители, ОснСредства, Параметры, Поставщики, Сотрудники, СтуктурнПодразделения, Формы, ВспомДата

Рабочие запросы в базе:

запрос_АктыПриемки, запрос_АктыРемонта, запрос_АктыСписания, запрос_АктыСписанияТовары, запрос_ВнутренниеНакл, запрос_ВнутренниеНаклТовары, запрос_Инвентаризации, запрос_ИнвентаризацииТовары, запрос_ИнвКарты, запрос_ИнвКнига, запрос_ИнвКнига2

Рабочие формы в базе:

Главная, Календарь, форма_АктПриемки, форма_АктРемонта, форма_АктСписания, форма_АктыСписанияТовары, форма_ВнутренниеНакл, форма_ВнутренниеНаклТовары, форма_ВспомДата, форма_Должности, форма_Инв, форма_ИнвентаризацииТовары, форма_ИнвКарта, форма_ИсполнителиРабот, форма_ОсновныеСредства, форма_Поставщики, форма_РеквизитыФирмы, форма_Сотрудники, форма_СписокАктовПриемки, форма_СписокАктовРемонта, форма_СписокАктовСписания, форма_СписокВнутренниеНакл, форма_СписокИнв, форма_СписокИнвКарт, форма_СписокОснСредств, форма_СтуктурнПодразделения, форма_Формы.

Рабочие модули в базе:

Inv, OS1, OS2, OS3, OS4, OS6, OS6b, Общий, прописью

2.5 Схема взаимосвязи программных модулей и информационных файлов

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

Таблица 2.17.

Унифицированная форма для заполнения

Модуль для заполнения

Module OS1

ОС-1. xls

Module OS2

ОС-2. xls

Module OS3

ОС-3. xls

Module OS4

ОС-4. xls

Module OS6

ОС-6. xls

Module OS6б

ОС-6b. xls

Module Inv

инв. xls

Задачи, данным программным продуктом:

Заполнение формы ОС-1;

Заполнение формы ОС-2;

Заполнение формы ОС-3;

Заполнение формы ОС-4;

Заполнение формы ОС-6

Заполнение формы ОС-6б

Заполнение формы инвентаризации описи;

Схема взаимодействия задач системы, рис.2.17.

2

Рис.2.17 Схема взаимосвязей программных модулей и блоков.

2.6 Выбор и обоснование технических средств

Основные достоинства выбранной СУБД - доступность, простота удобство в конструировании, доработке, администрировании. Вместе с тем Access позволяет надежно хранить данные и эффективно их обрабатывать. Поэтому, начиная с Access 97, этот продукт стабильно держится в рейтинге настольных СУБД на первых местах. Сегодня наиболее популярен Access 2003, который входит в состав пакета MS Office 2003. К отдельным перечням достоинств стоит отнести и полную интеграцию с другими офисными приложениями - Word, Outlook, Excel.

Учитывая основные достоинства СУБД Microsoft Access, надо заметить, что хотя в ее отношении используется термин "настольная СУБД", тем не менее, популярность ее такова, что огромное количество малых и средних, а то и достаточно крупных предприятий ведут учет своей хозяйственной деятельности именно в разработках на основе Microsoft Access. Отдельным плюсом работы с этой СУБД является использования легкого в освоении и наглядного объектного языка программирования Visual Basic for Application (VBA), младшего родственника по функциональности полноценного высокоуровневого языка программирования Microsoft Visual Basic. Такая СУБД незаменима прежде всего для учетных, экономических и бухгалтерских задач.

Пожалуй наличие встроенного мощного инструмента - языка программирования окончательно позволяет сделать выбор в пользу СУБД Access. Так как MS Access является широко распространенным информационным продуктом, входит в семейство MS Office, то как правило дополнительных средств на приобретение этого программного продукта инее требуется.

Что касается взаимосвязи между блоками АСУ 1С Бухгалтерия и модуль на СУБД Access, то при необходимости между ними можно организовать схему импорта данных, например, в формат DBF (db2 и т.д.), а затем добавить блок считывания (импорта) в модуль Access. Однако, плюс разработанного модуля заключается в том, что он обладает полной автономией: при необходимости данные для нового документа можно внести непосредственно через его интерфейс. Таки образом, слишком сложной схемы связи нет.

В конфигурацию, достаточную для бесперебойной и качественной работы системы входят процессор с частотой не менее 800МГЦ, системная плата на основе набора микросхем Intel, поддерживающая все современные стандарты и процессоры.

Нормальная работа с программой возможна при наличии 128 Мбайт оперативной памяти. На емкость жесткого диска особенно сильно влияет не сколько размер самих программ, сколько объем данных, необходимый для работы с ними. Приемлемая емкость жесткого диска 16 Гбайт. Установка диска меньшей емкости может отрицательно сказаться на работе с увеличивающимися базами данных. Операционная система от Windows 2000/XP.

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

СаНПиН 2.2.4/2.8056-96 "Электромагнитные излучения радиочастотного диапазона";

ГОСТ Р 50377-92 (МЭК 950-86)"Безопасность оборудования информационной технологии, включая электрическое конторское оборудование";

ГОСТ 27201-87 "Машины вычислительные электронные персональные. Типы, основные параметры, общие технические требования".

2.7 Экономическое обоснование проекта

Как известно, экономическое обоснование может быть проведено по следующим основным направлениям получения эффекта:

сравнение вариантов организации ЭИС по комплексу задач (например, сравнение ЭИС, предлагаемой в проекте, с существующей);

сравнение вариантов организации информационной базы комплекса задач (файловая организация и база данных);

сравнение вариантов организации технологического процесса сбора, передачи, обработки и выдачи информации;

сравнение вариантов технологии проектирования ЭИС (например, индивидуального проектирования с методами, использующими пакеты программ или модельного проектирования);

сравнение вариантов технологии внутримашинной обработки данных.

Приведем результат сравнения по выше указанным направлениям в табл.2.18.

Таблица 2.18.

Имеющаяся АСУ

Имеющаяся АСУ + разработанный в дипломном проекте модуль

Комплекс задач и функций, обеспеченный типовой конфигурацией УСН

Дополнительная функциональность, связанная с автоматическим заполнением унифицированных форм

Стандартная организация структуры и хранения данных, которая полностью обеспечена и контролируется комплексом 1С Бухгалтерией

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

Технологический процесс, обеспеченный комплексом 1С Бухгалтерией

Технологический процесс сохраняется примерно таким же

Дополнительный модуль обеспечен другой СУБД, это некоторое усложнение системы, но из всех вариантов СУБД самое менее затратное

Расчет затрат на разработку.

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

В соответствии с ГОСТ 24.702-85 целесообразны варианты построения экономических информационных систем выбираются путем балансирования показателей приращения эффекта Э, получаемого за счет создания или совершенствования АИС, и затрат Q. Математически эту задачу формулируют в виде

Мах Э при Q = const или min Q при Э = const.

При оценки эффективности используют обобщающие и частные показатели.

К основным обобщающим показателям экономической эффективности относятся:

Годовой экономический эффект;

Расчетный коэффициент эффективности капитальных затрат;

Срок окупаемости системы.

Годовой экономический эффект (Э) определяется по формуле:

Э = П-К*ЕН (2.1)

где П - годовая экономия (годовой прирост прибыли), тыс. руб.;

К - единовременные затраты, тыс. руб.;

ЕН - нормативный коэффициент эффективности капитальных вложений.

Коэффициент экономической эффективности капитальных затрат (ЕP) определяется по формуле:

ЕP = П/К (2.2)

Срок окупаемости (Т) исчисляется по формуле:

Т = К/П (2.3)

Расчет перечисленных обобщающих показателей предполагает предварительное вычисление частных показателей, характеризующих создаваемую АИС. Опишем и рассчитаем эти показатели.

Затраты на разработку системы (Кп) определяются по формуле:

Кп = Фз/п [ (1 + вд) (1 + вс) + вн + впр] + tэвм•Смч (2.4)

где Фз/п - фонд основной заработной платы разработчиков и других исполнителей работ, руб.;

вд - коэффициент дополнительной зарплаты (составит ОД);

вс - коэффициент отчислений на социальные нужды от основной и дополнительной заработной платы (составит 0,4);

вн - коэффициент накладных расходов организации, разрабатывающей проект (составит 0,6);

впр - коэффициент прочих расходов (0,1);

tэвм - машинное время, затраченное для отладки программного обеспечения, ч (составляет 240 ч);

Смч - стоимость машино-часа работы компьютера, руб. Расчет фонда основной заработной платы исполнителей работ по разработке рассчитывается как произведение суммарной трудоемкости работ по разработке системы (чел. - дн) и тарифной дневной ставки разработчиков.

Таким образом, исходя из линейного графика работ, продолжительность работ составляет 100 дней. Тарифная дневная ставка бухгалтера составляет 100 руб. Следовательно, Фз/п= 60 * 100 = 6000 руб.

Себестоимость машино-часа работы компьютера определяется по формуле:

См. ч = (Зп + А + Зэ + Зр + Зн+Зм) /Фд (2.5)

где, Зп - затраты на заработную плату обслуживающего персонала с учетом всех отчислений, руб;

А - годовая сумма амортизации, руб;%

Зэ - затраты на силовую энергию, руб.;

Зр - затраты на ремонт и обслуживание оборудования в год, руб.;

Зм - затраты на материалы в год, руб.;

Зн - накладные расходы, руб.;

Фд - действительный годовой фонд времени работы АИС, ч. По данным бухгалтерии затраты на заработную плату персонала (Зп) составит - 15000 руб.

Годовые амортизационные (А) отчисления считаются по формуле:

А = (Ск*НА) /100 (2.6)

где Ск - стоимость компьютера и прочего оборудования, используемого при отладке системы и, составляющий 20000 руб.;

НА - норма амортизации принимается равной 12%;

А = (20000 * 12) / 100 = 2400 руб.

Затраты на электроэнергию в год (Зэ) определяется по формуле:

Зэ = Wу*Сэ*Тb (2.7)

где Wу - установленная мощность, равная 0,1 кВт;

Сэ - стоимость силовой электроэнергии, равна 0,70 р/кВт;

Тb - время, в течение года, когда оборудование потребляет электроэнергию, равно 1920 ч.;

Зэ = 0,1 * 0,70 * 1920 = 134,40 руб.

Затраты на текущие ремонты Зр и на материалы Зм в год берутся по данным бухгалтерии и составляет 4,5% от стоимости аппаратных средств.

Зр = 20000 * 4,5 /100 = 900 руб.

Зм = 20000 * 4,5/100 = 900 руб.

В накладные расходы включаются затраты на отопление, освещение и прочие. Они составляют 600 руб.

Годовой фонд времени Фд устанавливается исходя из номинального фонда времени и времени профилактики оборудования и ремонтов:

Фд=S*h*D-Тпр (2.8)

где, S - продолжительность смены, равна 8 ч.

h - количество смен, равно 1;

D - число рабочих дней в году равно 240 дней;

Тпр - время ремонтов и профилактики оборудования в год, равно 32ч.;

Фд = 8* 1 * 240-32 = 1888 ч.

По формуле (21) находим

См. ч = (15000 + 2400 + 134,40 + 900 + 600+900) /1888=10,5 руб.

Таким образом затраты на разработку системы рассчитаем по формуле (32)

Кп = 6000 * [ (1 + 0,1) (1 + 0,4) + 0,6 + 0,1] + 240*10,5 = 15720 руб.

Расчет минимальной цены разработки системы.

Минимальная цена разработки системы Zmin складывается из полных затрат на разработку Кп и минимально необходимой суммы прибыли nmin.

Zmin = Кп + Пmin (2.9)

Сумма прибыли рассчитывается исходя из планируемого минимального уровня рентабельности Rmin (составит 15%) по формуле:

Пmin = Kn*Rmin/100 (2.10)

Пmin = 15720 * 15 /100 = 2358 руб.

Таким образом,

Zmin = 15720 +2358 = 18078 руб.

Расчет экономических результатов от внедрения системы.

Для оценки экономических результатов от внедрения системы необходимо выявить ее влияние на конечные результаты деятельности организации. Годовая экономия от внедрения системы П определяется по формуле:

П = - Зтек (2.11)

где m - количество статей затрат, по которым может быть получена экономия = 2;

3i - экономия по i-й статье затрат, т. руб.;

Зтек - затраты на функционирование системы.

Годовая экономия идет по следующим статьям:

На снижение трудоемкости обработки информации 3i:

3! у, 32У - затраты на выполнение работ существующему варианту при ручном способе и в условиях автоматизации, руб.;

Т1!,, Т2И - трудоемкость обработки информации ручным способом, ч.

б - коэффициент, учитывающий дополнительную трудоемкость по обработке информации на вспомогательные операции (а = 2,0...3,0)

г - часовая тарифная ставка управленческих работников, руб.;

О - коэффициент, определяющий размер дополнительной заработной платы с учетом отчислений на социальные нужды (0,5).

R - коэффициент определяющий характер накладных расходов (0,4);

3i = 31y-32y (2.12)

31y = T1H* б *r (l + O + R); (2.13)

32y = T2H* б *r (l + O + R); (2.14)

31у = 3000 * 2,6 * 6 (1 + 0,5 + 0,4) = 88920 руб.

32У = 2800 * 2 * 6 (1 + 0,5 + 0,4) = 63 840 руб.

Эi = 85 500 - 68 400 = 22800 руб.

Затраты, связанные с работой аппаратных средств могут быть рассчитаны по формуле:

Зтек = Змв = См-ч * tкса (2.15)

где См-ч - себестоимость часа работы комплекса технических средств (КСА), руб. /ч

tкса - время использования КСА в год, ч.

Следовательно, 3тек = 10,5 * 240 = 2520 руб.

Таким образом годовая экономия от внедрения системы составляет:

П = 22800 - 2520 = 20280 руб.

Экономическая эффективность капитальных вложений.

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

На основании рассчитанных показателей по формуле (2.1) годовой экономический эффект составляет:

Э = 20280 - 18078 *0,15= 17568,3 руб.

По формуле (30) определим расчетный коэффициент экономической эффективности капитальных затрат:

Ер=20280/18078 = 1,12

По формуле (31) определим срок окупаемости:

Т = 18078/20280= 0,89 ? 10,68 месяца

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

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

Заключение

В данном дипломном проекте были успешно достигнуты следующие цели:

разработана схема автоматизированного учета основных средств предприятия в целом, подобран и настроен готовый комплекс ПО УСН 1С Бухгалтерии под нужды предприятия

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

реализован данный программный блок "с нуля" в среде СУБД MS Access - интерфейсная часть, хранение и обработка данных, разработаны необходимые шаблоны исходящих документов

спланирована удобная работа с разработанным блоком, обеспечение рабочего места бухгалтера данным ПО, обдуман механизм первичной информационной защиты, проанализированы возможности расширения данного продукта и прямой интеграции с основным учетным комплексом 1С Бухгалтерии УСН.

проведено экономическое обоснование разработанной учетной схемы, доказана ее окупаемость.

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

Список использованных источников

1. Баркер, Скотт Ф. Профессиональное программирование в Access 2002. - М.: Издательский дом "Вильямс", 2002. - 991 с.: ил.

2. Бекаревич Ю.Б., Пушкина Н.В. Самоучитель Microsoft Access 2002. - СПб.: BHV - Санкт-Петербург, 2002. - 718 с.

3. Глушаков С.В. Базы данных: Учеб. курс/ Глушаков С.В., Ломотько Д.В. - Харьков; Ростов н/Д; Киев: Фолио: Феникс: Абрис, 2000. - 504 с.

4. Гэпн К., Сарсон Т. Структурный системный анализ: средства и методы: В 2 ч.: Пер. с англ / Под ред. А.В. Козлинского. - М.: Эйтекс, 1993. - 310 с.

5. Дейт К. Дж. Введение в системы баз данных.: Пер. с англ. - 6-е изд. - К.: Диалектика, 1998. - 784 с.: ил.

6. Заикин О.А., Советов Б.Я. Проектирование интегрированных систем обработки информации и управления: Учебное пособие. - М.: МГАП "Мир Книги", 1994. - 190 с.

7. Заикина С.А. Шпаргалка по бухгалтерскому учету: Учебное пособие. - М.: Экзамен, 2006. - 32 с.

8. Калянов Г.Н. Консалтинг при автоматизации предприятий (подходы, методы, средства): Учебное пособие. - М.: СИНТЕГ, 1997. - 316 с.

9. Киммел П. Освой самостоятельно программирование для Microsoft Access 2000 за 24 часа: [Учебное пособие] / Пер.А.С. Варакин. - М.: Издательский дом "Вильямс", 2000. - 447 с.

10. Михеева В.Д., Харитонова И.А. Microsoft Access 2002. - СПб.: BHV - Санкт-Петербург, 2002. - 1021 с.

11. Новалис Сьюзанн. Access 2000. Руководство по VBA. - М., 2001. - 506 с.

12. Титоренко Г.А. Автоматизированные информационные технологии в экономике. - М.: Юнити, 2006. - 400 с.

13. Харитонов C.А. Упрощенная система налогообложения: особенности применения и методика ведения учета в 1С: Бухгалтерии 7.7. - М.: 1С-Паблишинг, 2005. - 319 с.

14. Хомоненко А.Д. Базы данных: Учебник для высш. учеб. заведений/ А.Д. Хомоненко, В.М. Цыганков, М.Г. Мальцев; Под ред.А.Д. Хомоненко. - 2-е изд., доп. и перераб. - СПб.: КОРОНА принт, 2002. - 672 с

Приложения

Код модуля Inv

Option Compare Database

Option Explicit

Private Const NomerForm As Long = 8

Private Const cFirmName As Byte = 1

Private Const rFirmName As Integer = 6

Private Const cFirmOKPO As Byte = 89

Private Const rFirmOKPO As Integer = 6

Private Const cStruct As Byte = 1

Private Const rStruct As Integer = 8

Private Const cNomer As Byte = 69

Private Const rNomer As Integer = 18

Private Const cDat As Byte = 81

Private Const rDat As Integer = 18

Private Const cOsn As Byte = 28

Private Const rOsn As Integer = 11

Private Const cOsnNomer As Byte = 89

Private Const rOsnNomer As Integer = 11

Private Const cOsnDate As Byte = 89

Private Const rOsnDate As Integer = 12

Private Const cDate1 As Byte = 89

Private Const rDate1 As Integer = 13

Private Const cDate2 As Byte = 89

Private Const rDate2 As Integer = 14

Private Const cMest As Byte = 13

Private Const rMest As Integer = 24

Private Const cMatDolzhn1 As Byte = 38

Private Const rMatDolzhn1 As Integer = 32

Private Const cMatDolzhn2 As Byte = 38

Private Const rMatDolzhn2 As Integer = 34

Private Const cMatDolzhn3 As Byte = 38

Private Const rMatDolzhn3 As Integer = 36

Private Const cMatName1 As Byte = 79

Private Const rMatName1 As Integer = 32

Private Const cMatName2 As Byte = 79

Private Const rMatName2 As Integer = 34

Private Const cMatName3 As Byte = 79

Private Const rMatName3 As Integer = 36

Private Const ciKol As Byte = 72

Private Const riKol As Integer = 28

Private Const ciStoim As Byte = 79

Private Const riStoim As Integer = 28

Private Const rSh1_1 As Integer = 10

Private Const rSh1_2 As Integer = 27

Private Const cNom As Byte = 1

Private Const cTovar As Byte = 6

Private Const cInv As Byte = 51

Private Const cDoc As Byte = 26

Private Const cDocDate As Byte = 32

Private Const cDocNomer As Byte = 38

Private Const cYear As Byte = 44

Private Const cZav As Byte = 58

Private Const cPasp As Byte = 65

Private Const cKol As Byte = 72

Private Const cSum As Byte = 79

Private Const ciKolNomProp As Byte = 27

Private Const riKolNomProp As Integer = 30

Private Const ciKolProp As Byte = 30

Private Const riKolProp As Integer = 32

Private Const ciSumProp As Byte = 20

Private Const riSumProp As Integer = 34

Private Const ciSumKopProp As Byte = 91

Private Const riSumKopProp As Integer = 36

Private Const ciKolNomProp2 As Byte = 27

Private Const riKolNomProp2 As Integer = 3

Private Const ciKolProp2 As Byte = 30

Private Const riKolProp2 As Integer = 5

Private Const ciSumProp2 As Byte = 20

Private Const riSumProp2 As Integer = 7

Private Const ciSumKopProp2 As Byte = 91

Private Const riSumKopProp2 As Integer = 9

Private Const cPredsDolzh As Byte = 19

Private Const rPredsDolzh As Integer = 13

Private Const cChl1Dolzh As Byte = 19

Private Const rChl1Dolzh As Integer = 15

Private Const cChl2Dolzh As Byte = 19

Private Const rChl2Dolzh As Integer = 17

Private Const cChl3Dolzh As Byte = 19

Private Const rChl3Dolzh As Integer = 19

Private Const cPredsName As Byte = 60

Private Const rPredsName As Integer = 13

Private Const cChl1Name As Byte = 60

Private Const rChl1Name As Integer = 15

Private Const cChl2Name As Byte = 60

Private Const rChl2Name As Integer = 17

Private Const cChl3Name As Byte = 60

Private Const rChl3Name As Integer = 19

Private Const c2MatDolzhn1 As Byte = 42

Private Const r2MatDolzhn1 As Integer = 26

Private Const c2MatDolzhn2 As Byte = 42

Private Const r2MatDolzhn2 As Integer = 28

Private Const c2MatDolzhn3 As Byte = 42

Private Const r2MatDolzhn3 As Integer = 30

Private Const c2MatName1 As Byte = 79

Private Const r2MatName1 As Integer = 26

Private Const c2MatName2 As Byte = 79

Private Const r2MatName2 As Integer = 28

Private Const c2MatName3 As Byte = 79

Private Const r2MatName3 As Integer = 30

Private Const cDatPodpDay As Byte = 43

Private Const rDatPodpDay As Integer = 33

Private Const cDatPodpMon As Byte = 47

Private Const rDatPodpMon As Integer = 33

Private Const cDatPodpYear As Byte = 63

Private Const rDatPodpYear As Integer = 33

Private Const cDatProvDay As Byte = 41

Private Const rDatProvDay As Integer = 38

Private Const cDatProvMon As Byte = 45

Private Const rDatProvMon As Integer = 38

Private Const cDatProvYear As Byte = 61

Private Const rDatProvYear As Integer = 38

Sub PrintFormInv (ByVal nomer As Long)

Dim db As Database, Rec As DAO. Recordset, RecList As DAO. Recordset

Dim oApp As Object

Dim StrFormName As String

Dim StrFile As String, s_folder As String, StrPath As String

Dim StrGlBuch As String

Dim StrFirmName As String, StrFirmOKPO As String, StrFirmAddr As String, StrFirmReq As String, StrStruct As String

Dim NomerVnutr As String, StrDate As Date

Dim StrOsn As String, StrDateOsn As Date, StrNomerOsn As String

Dim StrMest As String

Dim StrDate1 As Date, StrDate2 As Date

Dim StrMatDolzhn1 As String, StrMatDolzhn2 As String, StrMatDolzhn3 As String

Dim StrMatName1 As String, StrMatName2 As String, StrMatName3 As String

Dim StrPredsName As String, StrPredsDolzh As String

Dim StrChl1Name As String, StrChl1Dolzh As String

Dim StrChl2Name As String, StrChl2Dolzh As String

Dim StrChl3Name As String, StrChl3Dolzh As String

Dim StrProvName As String, StrProvDolzh As String

Dim StrDatePodp As Date, StrDateProv As Date

Dim StrItog As Double, StrItogKol As Long

Dim s_Sum As Double, s_Kol As Long

Dim i As Long, NRecord As Long, p As Long

Dim StrMonthPodp As String, StrMonthProv As String

On Error GoTo LblErr

If nomer = 0 Then Exit Sub

s_folder = CurrentProject. Path

If Right$ (s_folder,

1) <> "\" Then s_folder = s_folder + "\"

s_folder = s_folder + "blanks\"

If Len (Dir$ (s_folder, vbDirectory)) = 0 Then

MsgBox "Путь к папке с бланками " & s_folder & " не обнаружен!", vbCritical + vbOKOnly

Exit Sub

End If

Set db = CurrentDb

Set Rec = db. OpenRecordset ("select * from Формы where НомерФорма = " & NomerForm, dbOpenSnapshot)

If Rec. RecordCount > 0 Then

StrFormName = Rec. Fields ("Наименование"). Value

StrFile = Rec. Fields ("Файл"). Value

Else

Set Rec = Nothing

MsgBox "Нет информации о форме №" & NomerForm & "!", vbCritical + vbOKOnly

Exit Sub

End If

Set Rec = Nothing

StrPath = s_folder + StrFile

If Len (Dir$ (StrPath)) = 0 Then

MsgBox "Файл бланка формы '" & StrFormName & "' " & StrPath & " не обнаружен!", vbCritical + vbOKOnly

Exit Sub

End If

Set Rec = db. OpenRecordset ("SELECT * FROM Параметры", dbOpenSnapshot)

If Rec. RecordCount > 0 Then

StrFirmName = Nz (Rec. Fields ("НаименованиеФирмы"). Value, "")

StrFirmOKPO = Nz (Rec. Fields ("ОКПО"). Value, "")

Else

MsgBox "Общие параметры фирмы не занесены!", vbCritical + vbOKOnly

Exit Sub

End If

Set Rec = Nothing

Set Rec = db. OpenRecordset ("select * from запрос_Инвентаризации where НомерИнв = " & nomer, dbOpenSnapshot)

If Rec. RecordCount > 0 Then

NomerVnutr = Nz (Rec. Fields ("НомерВнутр"). Value, nomer)

StrDate = Nz (Rec. Fields ("ДатаИнв"). Value, Date)

StrOsn = Nz (Rec. Fields ("Основание"). Value, "")

StrDateOsn = Nz (Rec. Fields ("ДатаОсн"). Value, Date)

StrNomerOsn = Nz (Rec. Fields ("НомерОсн"). Value, "")

StrMest = Nz (Rec. Fields ("Местонахождение"). Value, "")

StrStruct = Nz (Rec. Fields ("СтруктурноеПодразделение"). Value, "")

StrDate1 = Nz (Rec. Fields ("ДатаНачала"). Value, Date)

StrDate2 = Nz (Rec. Fields ("ДатаКонца"). Value, Date)

StrMatDolzhn1 = Nz (Rec. Fields ("mat_dolzhn1"). Value, "")

StrMatDolzhn2 = Nz (Rec. Fields ("mat_dolzhn2"). Value, "")

StrMatDolzhn3 = Nz (Rec. Fields ("mat_dolzhn3"). Value, "")

StrMatName1 = Nz (Rec. Fields ("mat_Name1"). Value, "")

StrMatName2 = Nz (Rec. Fields ("mat_Name2"). Value, "")

StrMatName3 = Nz (Rec. Fields ("mat_Name3"). Value, "")

StrPredsName = Nz (Rec. Fields ("preds_name"). Value, "")

StrPredsDolzh = Nz (Rec. Fields ("preds_dolzhn"). Value, "")

StrChl1Name = Nz (Rec. Fields ("chl1_name"). Value, "")

StrChl1Dolzh = Nz (Rec. Fields ("chl1_dolzhn"). Value, "")

StrChl2Name = Nz (Rec. Fields ("chl2_name"). Value, "")

StrChl2Dolzh = Nz (Rec. Fields ("chl2_dolzhn"). Value, "")

StrChl3Name = Nz (Rec. Fields ("chl3_name"). Value, "")

StrChl3Dolzh = Nz (Rec. Fields ("chl3_dolzhn"). Value, "")

StrProvName = Nz (Rec. Fields ("prov_name"). Value, "")

StrProvDolzh = Nz (Rec. Fields ("prov_dolzhn"). Value, "")

StrDatePodp = Nz (Rec. Fields ("ДатаПодписи"). Value, Date)

StrDateProv = Nz (Rec. Fields ("ДатаПроверки"). Value, Date)

Else

MsgBox "Инв. опись ОС №" & nomer & " не найдена!", vbCritical + vbOKOnly

Exit Sub

End If

Set Rec = Nothing

Set Rec = db. OpenRecordset ("select * from ВспомДата where НомерМес = " & Month (StrDatePodp), dbOpenSnapshot)

If Rec. RecordCount > 0 Then

StrMonthPodp = Nz (Rec. Fields ("НазвМес"). Value, "")

Else

StrMonthPodp = "нет названия"

End If

Set Rec = Nothing

Set Rec = db. OpenRecordset ("select * from ВспомДата where НомерМес = " & Month (StrDateProv), dbOpenSnapshot)

If Rec. RecordCount > 0 Then

StrMonthProv = Nz (Rec. Fields ("НазвМес"). Value, "")

Else

StrMonthProv = "нет названия"

End If

Set Rec = Nothing

Set oApp = CreateObject ("Excel. Application")

oApp. Workbooks. Open FileName: =StrPath, ReadOnly: =True

oApp. ActiveWorkbook. Sheets (1). Select

oApp. Cells (rFirmName, cFirmName). Value = StrFirmName

oApp. Cells (rFirmOKPO, cFirmOKPO). Value = StrFirmOKPO

oApp. Cells (rStruct, cStruct). Value = StrStruct

oApp. Cells (rOsn, cOsn). Value = StrOsn

oApp. Cells (rOsnDate, cOsnDate). Value = StrDateOsn

oApp. Cells (rOsnNomer, cOsnNomer). Value = StrNomerOsn

oApp. Cells (rDate1, cDate1). Value = Format$ (StrDate1, "dd. mm. yyyy")

oApp. Cells (rDate2, cDate2). Value = Format$ (StrDate2, "dd. mm. yyyy")

oApp. Cells (rMest, cMest). Value = StrMest

oApp. Cells (rMatDolzhn1, cMatDolzhn1). Value = StrMatDolzhn1

oApp. Cells (rMatDolzhn2, cMatDolzhn2). Value = StrMatDolzhn2

oApp. Cells (rMatDolzhn3, cMatDolzhn3). Value = StrMatDolzhn3

oApp. Cells (rMatName1, cMatName1). Value = StrMatName1

oApp. Cells (rMatName2, cMatName2). Value = StrMatName2

oApp. Cells (rMatName3, cMatName3). Value = StrMatName3

oApp. ActiveWorkbook. Sheets (2). Select

Application. SysCmd acSysCmdInitMeter, "Вывод информации о товарах", 100

StrItog = 0

StrItogKol = 0

Set RecList = db. OpenRecordset ("select * from запрос_ИнвентаризацииТовары where НомерИнв = " & nomer, dbOpenSnapshot)

NRecord = RecList. RecordCount

If NRecord > 0 Then

RecList. MoveLast

NRecord = RecList. RecordCount

RecList. MoveFirst

i = 0

p = rSh1_1 - 1

While Not RecList. EOF

i = i + 1

p = p + 1

Application. SysCmd acSysCmdUpdateMeter, i / NRecord * 100

If p > rSh1_2 Then GoTo lbl_ex

s_Sum = Nz (RecList. Fields ("Сумма"). Value, 0)

s_Kol = Nz (RecList. Fields ("Количество"). Value, 0)

oApp. Cells (p, cNom). Value = i

oApp. Cells (p, cTovar). Value = Nz (RecList. Fields ("Товар"). Value, "")

oApp. Cells (p, cDoc). Value = Nz (RecList. Fields ("ОснованиеПринятия"). Value, "")

oApp. Cells (p, cDocDate). Value = Format$ (Nz (RecList. Fields ("ДокДатаПринятия"). Value, Date), "dd. mm. yyyy")

oApp. Cells (p, cDocNomer). Value = Nz (RecList. Fields ("ДокНомерПринятия"). Value, "")

oApp. Cells (p, cYear). Value = Nz (RecList. Fields ("ГодВыпуска"). Value, Year (Date))

oApp. Cells (p, cInv). Value = Nz (RecList. Fields ("ИнвКод"). Value, "")

oApp. Cells (p, cPasp). Value = Nz (RecList. Fields ("НомерПоПаспорту"). Value, "")

oApp. Cells (p, cZav). Value = Nz (RecList. Fields ("НомерЗавод"). Value, "")

oApp. Cells (p, cKol). Value = s_Kol

oApp. Cells (p, cSum). Value = Format$ (s_Sum, "0.00")

StrItogKol = StrItogKol + s_Kol

StrItog = StrItog + s_Sum

RecList. MoveNext

Wend

Else

MsgBox "Для описи №" & nomer & " нет перечня товаров!", vbCritical + vbOKOnly

Exit Sub

End If

lbl_ex:

Set RecList = Nothing

oApp. Cells (riKol, ciKol). Value = StrItogKol

oApp. Cells (riStoim, ciStoim). Value = StrItog

oApp. Cells (riKolNomProp, ciKolNomProp). Value = translateNumber (i)

oApp. Cells (riKolProp, ciKolProp). Value = translateNumber (StrItogKol)

oApp. Cells (riSumProp, ciSumProp). Value = translateNumber (Int (StrItog))

oApp. Cells (riSumKopProp, ciSumKopProp). Value = Format$ (Int ( (StrItog - Int (StrItog)) * 100 + 0.5), "00")

oApp. ActiveWorkbook. Sheets (3). Select

oApp. Cells (riKolNomProp2, ciKolNomProp2). Value = translateNumber (i)

oApp. Cells (riKolProp2, ciKolProp2). Value = translateNumber (StrItogKol)

oApp. Cells (riSumProp2, ciSumProp2). Value = translateNumber (Int (StrItog))

oApp. Cells (riSumKopProp2, ciSumKopProp2). Value = Format$ (Int ( (StrItog - Int (StrItog)) * 100 + 0.5), "00")

oApp. Cells (rPredsName, cPredsName). Value = StrPredsName

oApp. Cells (rPredsDolzh, cPredsDolzh). Value = StrPredsDolzh

oApp. Cells (rChl1Name, cChl1Name). Value = StrChl1Name

oApp. Cells (rChl1Dolzh, cChl1Dolzh). Value = StrChl1Dolzh

oApp. Cells (rChl2Name, cChl2Name). Value = StrChl2Name

oApp. Cells (rChl2Dolzh, cChl2Dolzh). Value = StrChl2Dolzh

oApp. Cells (rChl3Name, cChl3Name). Value = StrChl3Name

oApp. Cells (rChl3Dolzh, cChl3Dolzh). Value = StrChl3Dolzh

oApp. Cells (r2MatDolzhn1, c2MatDolzhn1). Value = StrMatDolzhn1

oApp. Cells (r2MatDolzhn2, c2MatDolzhn2). Value = StrMatDolzhn2

oApp. Cells (r2MatDolzhn3, c2MatDolzhn3). Value = StrMatDolzhn3

oApp. Cells (r2MatName1, c2MatName1). Value = StrMatName1

oApp. Cells (r2MatName2, c2MatName2). Value = StrMatName2

oApp. Cells (r2MatName3, c2MatName3). Value = StrMatName3

oApp. Cells (rDatPodpDay, cDatPodpDay). Value = Format$ (StrDatePodp, "dd")

oApp. Cells (rDatPodpMon, cDatPodpMon). Value = StrMonthPodp

oApp. Cells (rDatPodpYear, cDatPodpYear). Value = Format$ (StrDatePodp, "yyyy")

oApp. Cells (rDatProvDay, cDatProvDay). Value = Format$ (StrDateProv, "dd")

oApp. Cells (rDatProvMon, cDatProvMon). Value = StrMonthProv

oApp. Cells (rDatProvYear, cDatProvYear). Value = Format$ (StrDateProv, "yyyy")

ex:

Application. SysCmd acSysCmdRemoveMeter

If Not (oApp Is Nothing) Then oApp. Visible = True

Set RecList = Nothing

Set oApp = Nothing

Set db = Nothing

Exit Sub

LblErr:

MsgBox Err. Description, vbCritical + vbOKOnly

GoTo ex

End Sub

Код модуля OS1

Option Compare Database

Option Explicit

Private Const NomerForm As Long = 3

Private Const cRukDolzh As Byte = 56

Private Const rRukDolzh As Integer = 4

Private Const cRukName As Byte = 85

Private Const rRukName As Integer = 4

Private Const cDatRukDay As Byte = 62

Private Const rDatRukDay As Integer = 6

Private Const cDatRukMon As Byte = 66

Private Const rDatRukMon As Integer = 6

Private Const cDatRukYear As Byte = 79

Private Const rDatRukYear As Integer = 6

Private Const cFirmName As Byte = 16

Private Const rFirmName As Integer = 9

Private Const cFirmOKPO As Byte = 88

Private Const rFirmOKPO As Integer = 9

Private Const cFirmAddr As Byte = 1

Private Const rFirmAddr As Integer = 11

Private Const cFirmReq As Byte = 1

Private Const rFirmReq As Integer = 13

Private Const cOsn As Byte = 18

Private Const rOsn As Integer = 25

Private Const cDatPriem As Byte = 88

Private Const rDatPriem As Integer = 28

Private Const cSchet As Byte = 88

Private Const rSchet As Integer = 30

Private Const cAmort As Byte = 88

Private Const rAmort As Integer = 32

Private Const cInv As Byte = 88

Private Const rInv As Integer = 33

Private Const cNomer As Byte = 36

Private Const rNomer As Integer = 32

Private Const cDat As Byte = 49

Private Const rDat As Integer = 32

Private Const cTovar As Byte = 15

Private Const rTovar As Integer = 36

Private Const cMest As Byte = 29

Private Const rMest As Integer = 39

Private Const cPerv As Byte = 65

Private Const rPerv As Integer = 13

Private Const cSrok As Byte = 73

Private Const rSrok As Integer = 13

Private Const cType As Byte = 81

Private Const rType As Integer = 13

Private Const cName2 As Byte = 1

Private Const rName2 As Integer = 24

Private Const cKol As Byte = 37

Private Const rKol As Integer = 24

Private Const cDatIspDay As Byte = 20

Private Const rDatIspDay As Integer = 3

Private Const cDatIspMon As Byte = 24

Private Const rDatIspMon As Integer = 3

Private Const cDatIspYear As Byte = 37

Private Const rDatIspYear As Integer = 3

Private Const cSootv1 As Byte = 31

Private Const rSootv1 As Integer = 5

Private Const cSootv2 As Byte = 31

Private Const rSootv2 As Integer = 6

Private Const cDorab1 As Byte = 57

Private Const rDorab1 As Integer = 5

Private Const cDorab2 As Byte = 57

Private Const rDorab2 As Integer = 6

Private Const cSootvInf As Byte = 1

Private Const rSootvInf As Integer = 7

Private Const cDorabInf As Byte = 51

Private Const rDorabInf As Integer = 7

Private Const cResult As Byte = 13

Private Const rResult As Integer = 11

Private Const cTDoc As Byte = 22

Private Const rTDoc As Integer = 13

Private Const cPredsDolzh As Byte = 15

Private Const rPredsDolzh As Integer = 14

Private Const cChl1Dolzh As Byte = 15

Private Const rChl1Dolzh As Integer = 16

Private Const cChl2Dolzh As Byte = 15

Private Const rChl2Dolzh As Integer = 18

Private Const cPredsName As Byte = 49

Private Const rPredsName As Integer = 14

Private Const cChl1Name As Byte = 49

Private Const rChl1Name As Integer = 16

Private Const cChl2Name As Byte = 49

Private Const rChl2Name As Integer = 18

Private Const cPrinDolzh As Byte = 56

Private Const rPrinDolzh As Integer = 24

Private Const cPrinName As Byte = 85

Private Const rPrinName As Integer = 24

Private Const cDatPrinDay As Byte = 52

Private Const rDatPrinDay As Integer = 27

Private Const cDatPrinMon As Byte = 56

Private Const rDatPrinMon As Integer = 27

Private Const cDatPrinYear As Byte = 69

Private Const rDatPrinYear As Integer = 27

Private Const cDatDovDay As Byte = 63

Private Const rDatDovDay As Integer = 28

Private Const cDatDovMon As Byte = 67

Private Const rDatDovMon As Integer = 28

Private Const cDatDovYear As Byte = 80

Private Const rDatDovYear As Integer = 28

Private Const cDatDovNomer As Byte = 85

Private Const rDatDovNomer As Integer = 28

Private Const cDatDovOsn As Byte = 57

Private Const rDatDovOsn As Integer = 29

Private Const cXranDolzh As Byte = 51

Private Const rXranDolzh As Integer = 32

Private Const cXranName As Byte = 80

Private Const rXranName As Integer = 32

Private Const cDatXranDay As Byte = 52

Private Const rDatXranDay As Integer = 35

Private Const cDatXranMon As Byte = 56

Private Const rDatXranMon As Integer = 35

Private Const cDatXranYear As Byte = 69

Private Const rDatXranYear As Integer = 35

Private Const cXranNomer As Byte = 85

Private Const rXranNomer As Integer = 34

Private Const cNomer2 As Byte = 80

Private Const rNomer2 As Integer = 39

Private Const cDatSost As Byte = 90

Private Const rDatSost As Integer = 39

Private Const cBuchName As Byte = 75

Private Const rBuchName As Integer = 41

Sub PrintFormOS1 (ByVal nomer As Long)

Dim db As Database, Rec As DAO. Recordset, RecList As DAO. Recordset

Dim oApp As Object

Dim StrFormName As String

Dim StrFile As String, s_folder As String, StrPath As String

Dim StrGlBuch As String

Dim StrFirmName As String, StrFirmOKPO As String, StrFirmAddr As String, StrFirmReq As String

Dim StrRukName As String, StrRukDolzh As String

Dim StrDatePodp As Date, StrDatePriem As Date, StrDate As Date, StrDateIsp As Date, StrPrinDate As Date, StrDovDate As Date, StrXranDate As Date

Dim StrOsn As String, StrSchet As String, StrAmort As String

Dim NomerVnutr As String, StrTovar As String

Dim StrInv As String

Dim StrStoim As Double, StrSroki As Long

Dim StrMethod As String, StrMest As String

Dim StrKol As Long

Dim vbSootv As Boolean, vbDorab As Boolean

Dim StrSootv As String, StrDorab As String

Dim StrZakl As String, StrTechDoc As String

Dim StrPredsName As String, StrPredsDolzh As String

Dim StrChl1Name As String, StrChl1Dolzh As String

Dim StrChl2Name As String, StrChl2Dolzh As String

Dim StrPrinName As String, StrPrinDolzh As String

Dim StrDovFor As String, StrDovNom As String

Dim StrXranName As String, StrXranDolzh As String, StrXranNomer As String

Dim StrMonthPodp As String, StrMonthIsp As String, StrMonthPrin As String, StrMonthDov As String, StrMonthXran As String

On Error GoTo LblErr

If nomer = 0 Then Exit Sub

s_folder = CurrentProject. Path

If Right$ (s_folder,

1) <> "\" Then s_folder = s_folder + "\"

s_folder = s_folder + "blanks\"

If Len (Dir$ (s_folder, vbDirectory)) = 0 Then

MsgBox "Путь к папке с бланками " & s_folder & " не обнаружен!", vbCritical + vbOKOnly

Exit Sub

End If

Set db = CurrentDb

Set Rec = db. OpenRecordset ("select * from Формы where НомерФорма = " & NomerForm, dbOpenSnapshot)

If Rec. RecordCount > 0 Then

StrFormName = Rec. Fields ("Наименование"). Value

StrFile = Rec. Fields ("Файл"). Value

Else

Set Rec = Nothing

MsgBox "Нет информации о форме №" & NomerForm & "!", vbCritical + vbOKOnly

Exit Sub

End If

Set Rec = Nothing

StrPath = s_folder + StrFile

If Len (Dir$ (StrPath)) = 0 Then

MsgBox "Файл бланка формы '" & StrFormName & "' " & StrPath & " не обнаружен!", vbCritical + vbOKOnly

Exit Sub

End If

Set Rec = db. OpenRecordset ("SELECT Параметры. *, Сотрудники. Сотрудник FROM Сотрудники INNER JOIN Параметры ON Сотрудники. НомерСотр = Параметры. ГлБухгалтер", dbOpenSnapshot)

If Rec. RecordCount > 0 Then

StrFirmName = Nz (Rec. Fields ("НаименованиеФирмы"). Value, "")

StrFirmOKPO = Nz (Rec. Fields ("ОКПО"). Value, "")

StrGlBuch = Nz (Rec. Fields ("Сотрудник"). Value, "")

StrFirmAddr = Nz (Rec. Fields ("ЮрАдрес"). Value, "")

StrFirmReq = Nz (Rec. Fields ("БанкРеквизиты"). Value, "")

Else

MsgBox "Общие параметры фирмы не занесены!", vbCritical + vbOKOnly

Exit Sub

End If

Set Rec = Nothing

Set Rec = db. OpenRecordset ("select * from запрос_АктыПриемки where НомерАкт = " & nomer, dbOpenSnapshot)

If Rec. RecordCount > 0 Then

StrRukName = Nz (Rec. Fields ("s_ruk"). Value, "")

StrRukDolzh = Nz (Rec. Fields ("d_ruk"). Value, "")

StrDatePodp = Nz (Rec. Fields ("ДатаПодписи"). Value, Date)

StrOsn = Nz (Rec. Fields ("Основание"). Value, "")

StrDatePriem = Nz (Rec. Fields ("ДатаПриемки"). Value, Date)

StrSchet = Nz (Rec. Fields ("Счет"). Value, "")

StrAmort = Nz (Rec. Fields ("НомерАмортГруппы"). Value, "")

NomerVnutr = Nz (Rec. Fields ("НомерВнутр"). Value, nomer)

StrDate = Nz (Rec. Fields ("ДатаАкта"). Value, Date)

StrTovar = Nz (Rec. Fields ("Товар"). Value, "")

StrInv = Nz (Rec. Fields ("ИнвКод"). Value, "")

StrStoim = Nz (Rec. Fields ("ПервСтоииость"). Value, 0)

StrSroki = Nz (Rec. Fields ("СрокИспользования"). Value, 0)

StrMethod = Nz (Rec. Fields ("СпособАморт"). Value, "")

StrMest = Nz (Rec. Fields ("Местонахождение"). Value, "")

StrKol = Nz (Rec. Fields ("Количество"). Value,

1)

StrDateIsp = Nz (Rec. Fields ("ДатаИспытания"). Value, Date)

vbSootv = Nz (Rec. Fields ("Соотвествие"). Value, True)

vbDorab = Nz (Rec. Fields ("Доработка"). Value, False)

StrSootv = Nz (Rec. Fields ("ЧтоСоотв"). Value, "")

StrDorab = Nz (Rec. Fields ("ЧтоДораб"). Value, "")

StrZakl = Nz (Rec. Fields ("Заключение"). Value, "")

StrTechDoc = Nz (Rec. Fields ("ТехДок"). Value, "")

StrPredsName = Nz (Rec. Fields ("s_preds"). Value, "")

StrPredsDolzh = Nz (Rec. Fields ("d_preds"). Value, "")

StrChl1Name = Nz (Rec. Fields ("s_4l1"). Value, "")

StrChl1Dolzh = Nz (Rec. Fields ("d_4l1"). Value, "")

StrChl2Name = Nz (Rec. Fields ("s_4l2"). Value, "")

StrChl2Dolzh = Nz (Rec. Fields ("d_4l2"). Value, "")

StrPrinName = Nz (Rec. Fields ("s_prin"). Value, "")

StrPrinDolzh = Nz (Rec. Fields ("d_prin"). Value, "")

StrPrinDate = Nz (Rec. Fields ("ДатаПринятия"). Value, Date)

StrDovFor = Nz (Rec. Fields ("ВыданаДов"). Value, "")

StrDovDate = Nz (Rec. Fields ("ДатаДов"). Value, Date)

StrDovNom = Nz (Rec. Fields ("НомерДов"). Value, "1")

StrXranName = Nz (Rec. Fields ("s_xran"). Value, "")

StrXranDolzh = Nz (Rec. Fields ("d_xran"). Value, "")

StrXranNomer = Nz (Rec. Fields ("s_nomer"). Value, "")

StrXranDate = Nz (Rec. Fields ("ДатаХранения"). Value, Date)

Else

MsgBox "Акт приемки №" & nomer & " не найден!", vbCritical + vbOKOnly

Exit Sub

End If

Set Rec = Nothing

Set Rec = db. OpenRecordset ("select * from ВспомДата where НомерМес = " & Month (StrDatePodp), dbOpenSnapshot)

If Rec. RecordCount > 0 Then

StrMonthPodp = Nz (Rec. Fields ("НазвМес"). Value, "")

Else

StrMonthPodp = "нет названия"

End If

Set Rec = Nothing

Set Rec = db. OpenRecordset ("select * from ВспомДата where НомерМес = " & Month (StrDateIsp), dbOpenSnapshot)

If Rec. RecordCount > 0 Then

StrMonthIsp = Nz (Rec. Fields ("НазвМес"). Value, "")

Else

StrMonthIsp = "нет названия"

End If

Set Rec = Nothing

Set Rec = db. OpenRecordset ("select * from ВспомДата where НомерМес = " & Month (StrPrinDate), dbOpenSnapshot)

If Rec. RecordCount > 0 Then

StrMonthPrin = Nz (Rec. Fields ("НазвМес"). Value, "")

Else

StrMonthPrin = "нет названия"

End If

Set Rec = Nothing

Set Rec = db. OpenRecordset ("select * from ВспомДата where НомерМес = " & Month (StrDovDate), dbOpenSnapshot)

If Rec. RecordCount > 0 Then

StrMonthDov = Nz (Rec. Fields ("НазвМес"). Value, "")

Else

StrMonthDov = "нет названия"

End If

Set Rec = Nothing

Set Rec = db. OpenRecordset ("select * from ВспомДата where НомерМес = " & Month (StrXranDate), dbOpenSnapshot)

If Rec. RecordCount > 0 Then

StrMonthXran = Nz (Rec. Fields ("НазвМес"). Value, "")

Else

StrMonthXran = "нет названия"

End If

Set Rec = Nothing

Set oApp = CreateObject ("Excel. Application")

oApp. Workbooks. Open FileName: =StrPath, ReadOnly: =True

oApp. ActiveWorkbook. Sheets (1). Select

oApp. Cells (rRukName, cRukName). Value = StrRukName

oApp. Cells (rRukDolzh, cRukDolzh). Value = StrRukDolzh

oApp. Cells (rDatRukDay, cDatRukDay). Value = Format$ (StrDatePodp, "dd")

oApp. Cells (rDatRukMon, cDatRukMon). Value = StrMonthPodp

oApp. Cells (rDatRukYear, cDatRukYear). Value = Right$ (Format$ (StrDatePodp, "yyyy"),

1)

oApp. Cells (rFirmName, cFirmName). Value = StrFirmName

oApp. Cells (rFirmOKPO, cFirmOKPO). Value = StrFirmOKPO

oApp. Cells (rFirmAddr, cFirmAddr). Value = StrFirmAddr

oApp. Cells (rFirmReq, cFirmReq). Value = StrFirmReq

oApp. Cells (rOsn, cOsn). Value = StrOsn

oApp. Cells (rDatPriem, cDatPriem). Value = Format$ (StrDatePriem, "dd. mm. yyyy")

oApp. Cells (rSchet, cSchet). Value = StrSchet

oApp. Cells (rAmort, cAmort). Value = StrAmort

oApp. Cells (rInv, cInv). Value = StrInv

oApp. Cells (rNomer, cNomer). Value = NomerVnutr

oApp. Cells (rDat, cDat). Value = Format$ (StrDate, "dd. mm. yyyy")

oApp. Cells (rTovar, cTovar). Value = StrTovar

oApp. Cells (rMest, cMest). Value = StrMest

oApp. ActiveWorkbook. Sheets (2). Select

oApp. Cells (rPerv, cPerv). Value = StrStoim

oApp. Cells (rSrok, cSrok). Value = StrSroki

oApp. Cells (rType, cType). Value = StrMethod

oApp. Cells (rName2, cName2). Value = StrTovar

oApp. Cells (rKol, cKol). Value = StrKol & " шт."

oApp. ActiveWorkbook. Sheets (3). Select

oApp. Cells (rDatIspDay, cDatIspDay). Value = Format$ (StrDateIsp, "dd")

oApp. Cells (rDatIspMon, cDatIspMon). Value = StrMonthIsp

oApp. Cells (rDatIspYear, cDatIspYear). Value = Right$ (Format$ (StrDateIsp, "yyyy"),

1)

If vbSootv = True Then

oApp. Cells (rSootv1, cSootv1). Font. Bold = True

oApp. Cells (rSootv2, cSootv2). Font. Bold = False

oApp. Cells (rSootvInf, cSootvInf). Value = ""

Else

oApp. Cells (rSootv1, cSootv1). Font. Bold = False

oApp. Cells (rSootv2, cSootv2). Font. Bold = True

oApp. Cells (rSootvInf, cSootvInf). Value = StrSootv

End If

If vbDorab = True Then

oApp. Cells (rDorab1, cDorab1). Font. Bold = True

oApp. Cells (rDorab2, cDorab2). Font. Bold = False

oApp. Cells (rDorabInf, cDorabInf). Value = StrDorab

Else

oApp. Cells (rDorab1, cDorab1). Font. Bold = False

oApp. Cells (rDorab2, cDorab2). Font. Bold = True

oApp. Cells (rDorabInf, cDorabInf). Value = ""

End If

oApp. Cells (rResult, cResult). Value = StrZakl

oApp. Cells (rTDoc, cTDoc). Value = StrTechDoc

oApp. Cells (rPredsName, cPredsName). Value = StrPredsName

oApp. Cells (rPredsDolzh, cPredsDolzh). Value = StrPredsDolzh

oApp. Cells (rChl1Name, cChl1Name). Value = StrChl1Name

oApp. Cells (rChl1Dolzh, cChl1Dolzh). Value = StrChl1Dolzh

oApp. Cells (rChl2Name, cChl2Name). Value = StrChl2Name

oApp. Cells (rChl2Dolzh, cChl2Dolzh). Value = StrChl2Dolzh

oApp. Cells (rPrinName, cPrinName). Value = StrPrinName

oApp. Cells (rPrinDolzh, cPrinDolzh). Value = StrPrinDolzh

oApp. Cells (rDatPrinDay, cDatPrinDay). Value = Format$ (StrPrinDate, "dd")

oApp. Cells (rDatPrinMon, cDatPrinMon). Value = StrMonthPrin

oApp. Cells (rDatPrinYear, cDatPrinYear). Value = Right$ (Format$ (StrPrinDate, "yyyy"),

1)

oApp. Cells (rDatDovDay, cDatDovDay). Value = Format$ (StrDovDate, "dd")

oApp. Cells (rDatDovMon, cDatDovMon). Value = StrMonthDov

oApp. Cells (rDatDovYear, cDatDovYear). Value = Right$ (Format$ (StrDovDate, "yyyy"),

1)

oApp. Cells (rDatDovOsn, cDatDovOsn). Value = StrDovFor

oApp. Cells (rDatDovNomer, cDatDovNomer). Value = StrDovNom

oApp. Cells (rXranName, cXranName). Value = StrXranName

oApp. Cells (rXranDolzh, cXranDolzh). Value = StrXranDolzh

oApp. Cells (rXranNomer, cXranNomer). Value = StrXranNomer

oApp. Cells (rDatXranDay, cDatXranDay). Value = Format$ (StrXranDate, "dd")

oApp. Cells (rDatXranMon, cDatXranMon). Value = StrMonthXran

oApp. Cells (rDatXranYear, cDatXranYear). Value = Right$ (Format$ (StrXranDate, "yyyy"),

1)

oApp. Cells (rNomer2, cNomer2). Value = NomerVnutr

oApp. Cells (rDatSost, cDatSost). Value = Format$ (StrDate, "dd. mm. yyyy")

oApp. Cells (rBuchName, cBuchName). Value = StrGlBuch

ex:

Application. SysCmd acSysCmdRemoveMeter

If Not (oApp Is Nothing) Then oApp. Visible = True

Set Rec = Nothing

Set RecList = Nothing

Set oApp = Nothing

Set db = Nothing

Exit Sub

LblErr:

MsgBox Err. Description, vbCritical + vbOKOnly

GoTo ex

End Sub

Код модуля OS2

Option Compare Database

Option Explicit

Private Const NomerForm As Long = 2

Private Const cFirmName As Byte = 1

Private Const rFirmName As Integer = 7

Private Const cFirmOKPO As Byte = 88

Private Const rFirmOKPO As Integer = 7

Private Const cPodrazdName1 As Byte = 7

Private Const rPodrazdName1 As Integer = 9

Private Const cPodrazdOKPO1 As Byte = 88

Private Const rPodrazdOKPO1 As Integer = 8

Private Const cPodrazdName2 As Byte = 9

Private Const rPodrazdName2 As Integer = 11

Private Const cPodrazdOKPO2 As Byte = 88

Private Const rPodrazdOKPO2 As Integer = 10

Private Const cDateNakl As Byte = 69

Private Const rDateNakl As Integer = 16

Private Const cNomerNakl As Byte = 57

Private Const rNomerNakl As Integer = 16

Private Const cNomer As Byte = 1

Private Const cTovar As Byte = 5

Private Const cYear As Byte = 48

Private Const cInv As Byte = 58

Private Const cKol As Byte = 70

Private Const cCena As Byte = 80

Private Const cSum As Byte = 90

Private Const rSh1_1 As Integer = 24

Private Const rSh1_2 As Integer = 39

Private Const rSh2_1 As Integer = 8

Private Const rSh2_2 As Integer = 19

Private Const cSumItog As Byte = 90

Private Const rSumItog As Integer = 20

Private Const cSotrName1 As Byte = 42

Private Const rSotrName1 As Byte = 31

Private Const cSotrDolzh1 As Byte = 7

Private Const rSotrDolzh1 As Byte = 31

Private Const cSotrNomer1 As Byte = 64

Private Const rSotrNomer1 As Byte = 31

Private Const cDatDay1 As Byte = 79

Private Const rDatDay1 As Byte = 31

Private Const cDatMonth1 As Byte = 83

Private Const rDatMonth1 As Byte = 31

Private Const cDatYear1 As Byte = 96

Private Const rDatYear1 As Byte = 31

Private Const cSotrName2 As Byte = 42

Private Const rSotrName2 As Byte = 34

Private Const cSotrDolzh2 As Byte = 7

Private Const rSotrDolzh2 As Byte = 34

Private Const cSotrNomer2 As Byte = 64

Private Const rSotrNomer2 As Byte = 34

Private Const cDatDay2 As Byte = 79

Private Const rDatDay2 As Byte = 34

Private Const cDatMonth2 As Byte = 83

Private Const rDatMonth2 As Byte = 34

Private Const cDatYear2 As Byte = 96

Private Const rDatYear2 As Byte = 34

Private Const cGlBuch As Byte = 33

Private Const rGlBuch As Byte = 39

Private Const nSymbPrim As Byte = 60

Private Const nSymbPrim2 As Byte = 130

Private Const cPrim As Integer = 51

Private Const rPrim1 As Integer = 22

Private Const cPrim2 As Integer = 1

Private Const rPrim2_1 As Integer = 23

Private Const rPrim2_2 As Integer = 27

Sub PrintFormOS2 (ByVal nomer As Long)

Dim db As Database, Rec As DAO. Recordset, RecList As DAO. Recordset

Dim oApp As Object

Dim StrFormName As String

Dim StrFile As String, s_folder As String, StrPath As String

Dim StrGlBuch As String

Dim StrFirmName As String, StrFirmOKPO As String

Dim StrPodrazdName1 As String, StrPodrazdOKPO1 As String

Dim StrPodrazdName2 As String, StrPodrazdOKPO2 As String

Dim StrDate As Date, StrDate_s As Date, StrDate_p As Date

Dim StrNomer As String

Dim StrSotrName1 As String, StrSotrNomer1 As String, StrSotrDolzh1 As String

Dim StrSotrName2 As String, StrSotrNomer2 As String, StrSotrDolzh2 As String

Dim StrItog As Double, s_Sum As Double

Dim StrMonth1 As String, StrMonth2 As String

Dim p As Integer, p2 As Integer, i As Long, NRecord As Long

Dim StrPrim As String

On Error GoTo LblErr

If nomer = 0 Then Exit Sub

s_folder = CurrentProject. Path

If Right$ (s_folder,

1) <> "\" Then s_folder = s_folder + "\"

s_folder = s_folder + "blanks\"

If Len (Dir$ (s_folder, vbDirectory)) = 0 Then

MsgBox "Путь к папке с бланками " & s_folder & " не обнаружен!", vbCritical + vbOKOnly

Exit Sub

End If

Set db = CurrentDb

Set Rec = db. OpenRecordset ("select * from Формы where НомерФорма = " & NomerForm, dbOpenSnapshot)

If Rec. RecordCount > 0 Then

StrFormName = Rec. Fields ("Наименование"). Value

StrFile = Rec. Fields ("Файл"). Value

Else

Set Rec = Nothing

MsgBox "Нет информации о форме №" & NomerForm & "!", vbCritical + vbOKOnly

Exit Sub

End If

Set Rec = Nothing

StrPath = s_folder + StrFile

If Len (Dir$ (StrPath)) = 0 Then

MsgBox "Файл бланка формы '" & StrFormName & "' " & StrPath & " не обнаружен!", vbCritical + vbOKOnly

Exit Sub

End If

Set Rec = db. OpenRecordset ("SELECT Параметры. *, Сотрудники. Сотрудник FROM Сотрудники INNER JOIN Параметры ON Сотрудники. НомерСотр = Параметры. ГлБухгалтер", dbOpenSnapshot)

If Rec. RecordCount > 0 Then

StrFirmName = Nz (Rec. Fields ("НаименованиеФирмы"). Value, "")

StrFirmOKPO = Nz (Rec. Fields ("ОКПО"). Value, "")

StrGlBuch = Nz (Rec. Fields ("Сотрудник"). Value, "")

Else

MsgBox "Общие параметры фирмы не занесены!", vbCritical + vbOKOnly

Exit Sub

End If

Set Rec = Nothing

Set Rec = db. OpenRecordset ("select * from запрос_ВнутренниеНакл where НомерНакл = " & nomer, dbOpenSnapshot)

If Rec. RecordCount > 0 Then

StrPodrazdName1 = Nz (Rec. Fields ("p1"). Value, "")

StrPodrazdOKPO1 = Nz (Rec. Fields ("p1_okpo"). Value, "")

StrPodrazdName2 = Nz (Rec. Fields ("p2"). Value, "")

StrPodrazdOKPO2 = Nz (Rec. Fields ("p2_okpo"). Value, "")

StrDate = Nz (Rec. Fields ("ДатаНакл"). Value, Date)

StrDate_s = Nz (Rec. Fields ("ДатаНаклСдал"). Value, Date)

StrDate_p = Nz (Rec. Fields ("ДатаНаклПринял"). Value, Date)

StrNomer = Nz (Rec. Fields ("НомерНаклВнутр"). Value, nomer)

StrSotrName1 = Nz (Rec. Fields ("s1"). Value, "")

StrSotrNomer1 = Nz (Rec. Fields ("s1_nomer"). Value, "")

StrSotrDolzh1 = Nz (Rec. Fields ("s1_dolzh"). Value, "")

StrSotrName2 = Nz (Rec. Fields ("s2"). Value, "")

StrSotrNomer2 = Nz (Rec. Fields ("s2_nomer"). Value, "")

StrSotrDolzh2 = Nz (Rec. Fields ("s2_dolzh"). Value, "")

StrPrim = Nz (Rec. Fields ("Примечание"). Value, "")

Else

MsgBox "Накладная №" & nomer & " не найдена!", vbCritical + vbOKOnly

Exit Sub

End If

Set Rec = Nothing

Set Rec = db. OpenRecordset ("select * from ВспомДата where НомерМес = " & Month (StrDate_s), dbOpenSnapshot)

If Rec. RecordCount > 0 Then

StrMonth1 = Nz (Rec. Fields ("НазвМес"). Value, "")

Else

StrMonth1 = "нет названия"

End If

Set Rec = Nothing

Set Rec = db. OpenRecordset ("select * from ВспомДата where НомерМес = " & Month (StrDate_p), dbOpenSnapshot)

If Rec. RecordCount > 0 Then

StrMonth2 = Nz (Rec. Fields ("НазвМес"). Value, "")

Else

StrMonth2 = "нет названия"

End If

Set Rec = Nothing

Set oApp = CreateObject ("Excel. Application")

oApp. Workbooks. Open FileName: =StrPath, ReadOnly: =True

Application. SysCmd acSysCmdInitMeter, "Вывод информации о товарах", 100

oApp. ActiveWorkbook. Sheets (1). Select

StrItog = 0

Set RecList = db. OpenRecordset ("select * from запрос_ВнутренниеНаклТовары where НомерНакл = " & nomer, dbOpenSnapshot)

NRecord = RecList. RecordCount

If NRecord > 0 Then

RecList. MoveLast

NRecord = RecList. RecordCount

RecList. MoveFirst

i = 0

oApp. ActiveWorkbook. Sheets (1). Select

p = rSh1_1 - 1: p2 = rSh1_2

While Not RecList. EOF

i = i + 1

p = p + 1

Application. SysCmd acSysCmdUpdateMeter, i / NRecord * 100

If p > p2 Then

oApp. ActiveWorkbook. Sheets (2). Select

p = rSh2_1: p2 = rSh2_2

End If

s_Sum = Nz (RecList. Fields ("Сумма"). Value, 0)

oApp. Cells (p, cNomer). Value = i

oApp. Cells (p, cTovar). Value = Nz (RecList. Fields ("Товар"). Value, "")

oApp. Cells (p, cYear). Value = Nz (RecList. Fields ("ГодВыпуска"). Value, Year (Date))

oApp. Cells (p, cInv). Value = Nz (RecList. Fields ("ИнвКод"). Value, Year (Date))

oApp. Cells (p, cKol). Value = Nz (RecList. Fields ("Количество"). Value, 0)

oApp. Cells (p, cCena). Value = Format$ (Nz (RecList. Fields ("ЦенаРозн"). Value, 0), "0.00")

oApp. Cells (p, cSum). Value = Format$ (s_Sum, "0.00")

StrItog = StrItog + s_Sum

RecList. MoveNext

Wend

Else

MsgBox "Для накладной №" & nomer & " нет перечня товаров!", vbCritical + vbOKOnly

Exit Sub

End If

Set RecList = Nothing

oApp. Cells (rFirmName, cFirmName). Value = StrFirmName

oApp. Cells (rFirmOKPO, cFirmOKPO). Value = StrFirmOKPO

oApp. Cells (rPodrazdName1, cPodrazdName1). Value = StrPodrazdName1

oApp. Cells (rPodrazdOKPO1, cPodrazdOKPO1). Value = StrPodrazdOKPO1

oApp. Cells (rPodrazdName2, cPodrazdName2). Value = StrPodrazdName2

oApp. Cells (rPodrazdOKPO2, cPodrazdOKPO2). Value = StrPodrazdOKPO2

oApp. Cells (rNomerNakl, cNomerNakl). Value = StrNomer

oApp. Cells (rDateNakl, cDateNakl). Value = Format$ (StrDate, "dd. mm. yyyy")

oApp. ActiveWorkbook. Sheets (2). Select

oApp. Cells (rSumItog, cSumItog). Value = " " & Format$ (StrItog, "0.00")

oApp. Cells (rSotrDolzh1, cSotrDolzh1). Value = StrSotrDolzh1

oApp. Cells (rSotrName1, cSotrName1). Value = StrSotrName1

oApp. Cells (rSotrNomer1, cSotrNomer1). Value = StrSotrNomer1

oApp. Cells (rDatDay1, cDatDay1). Value = Format$ (StrDate_s, "dd")

oApp. Cells (rDatMonth1, cDatMonth1). Value = StrMonth1

oApp. Cells (rDatYear1, cDatYear1). Value = Right$ (Format$ (StrDate_s, "yyyy"),

1)

oApp. Cells (rSotrDolzh2, cSotrDolzh2). Value = StrSotrDolzh2

oApp. Cells (rSotrName2, cSotrName2). Value = StrSotrName2

oApp. Cells (rSotrNomer2, cSotrNomer2). Value = StrSotrNomer2

oApp. Cells (rDatDay2, cDatDay2). Value = Format$ (StrDate_p, "dd")

oApp. Cells (rDatMonth2, cDatMonth2). Value = StrMonth2

oApp. Cells (rDatYear2, cDatYear2). Value = Right$ (Format$ (StrDate_p, "yyyy"),

1)

oApp. Cells (rPrim1, cPrim). Value = Left$ (StrPrim, nSymbPrim)

StrPrim = Mid$ (StrPrim, nSymbPrim + 1)

i = rPrim2_1

While Len (StrPrim) > 0

oApp. Cells (i, cPrim2). Value = Left$ (StrPrim, nSymbPrim2)

StrPrim = Mid$ (StrPrim, nSymbPrim2 + 1)

i = i + 1

If i > rPrim2_2 Then GoTo lb_ex

Wend

lb_ex:

oApp. Cells (rGlBuch, cGlBuch). Value = StrGlBuch

ex:

Application. SysCmd acSysCmdRemoveMeter

If Not (oApp Is Nothing) Then oApp. Visible = True

Set Rec = Nothing

Set RecList = Nothing

Set oApp = Nothing

Set db = Nothing

Exit Sub

LblErr:

MsgBox Err. Description, vbCritical + vbOKOnly

GoTo ex

End Sub

Код модуля OS3

Option Compare Database

Option Explicit

Private Const NomerForm As Long = 5

Private Const cFirmName As Byte = 7

Private Const rFirmName As Integer = 7

Private Const cFirmOKPO As Byte = 88

Private Const rFirmOKPO As Integer = 7

Private Const cNomer As Byte = 36

Private Const rNomer As Integer = 15

Private Const cDat As Byte = 48

Private Const rDat As Integer = 15

Private Const cIsp As Integer = 13

Private Const rIsp As Integer = 11

Private Const cIspOKPO As Integer = 88

Private Const rIspOKPO As Integer = 11

Private Const cdNomer As Integer = 88

Private Const rdNomer As Integer = 12

Private Const cdDate As Integer = 88

Private Const rdDate As Integer = 13

Private Const cPDate1 As Integer = 88

Private Const rPDate1 As Integer = 14

Private Const cPDate2 As Integer = 88

Private Const rPDate2 As Integer = 15

Private Const cFDate1 As Integer = 88

Private Const rFDate1 As Integer = 16

Private Const cFDate2 As Integer = 88

Private Const rFDate2 As Integer = 17

Private Const cRukDolzh As Byte = 61

Private Const rRukDolzh As Integer = 20

Private Const cRukName As Byte = 85

Private Const rRukName As Integer = 20

Private Const cDatRukDay As Byte = 54

Private Const rDatRukDay As Integer = 22

Private Const cDatRukMon As Byte = 58

Private Const rDatRukMon As Integer = 22

Private Const cDatRukYear As Byte = 71

Private Const rDatRukYear As Integer = 22

Private Const cTovar As Byte = 6

Private Const rTovar As Integer = 29

Private Const cInv As Byte = 30

Private Const rInv As Integer = 29

Private Const cPasp As Byte = 45

Private Const rPasp As Integer = 29

Private Const cZav As Byte = 60

Private Const rZav As Integer = 29

Private Const cOstStoim As Byte = 75

Private Const rOstStoim As Integer = 29

Private Const cFaktSrok As Byte = 90

Private Const rFaktSrok As Integer = 29

Private Const cTovar2 As Byte = 6

Private Const rTovar2 As Integer = 39

Private Const cOper As Byte = 20

Private Const rOper As Integer = 39

Private Const cDemStoim As Byte = 30

Private Const rDemStoim As Integer = 39

Private Const cPlRab As Byte = 40

Private Const rPlRab As Integer = 39

Private Const cPlRab2 As Byte = 50

Private Const rPlRab2 As Integer = 39

Private Const cFtRab As Byte = 60

Private Const rFtRab As Integer = 39

Private Const cFtRab2 As Byte = 70

Private Const rFtRab2 As Integer = 39

Private Const cTransp As Byte = 80

Private Const rTransp As Integer = 39

Private Const ciDemStoim As Byte = 30

Private Const riDemStoim As Integer = 41

Private Const ciPlRab As Byte = 40

Private Const riPlRab As Integer = 41

Private Const ciPlRab2 As Byte = 50

Private Const riPlRab2 As Integer = 41

Private Const ciFtRab As Byte = 60

Private Const riFtRab As Integer = 41

Private Const ciFtRab2 As Byte = 70

Private Const riFtRab2 As Integer = 41

Private Const ciTransp As Byte = 80

Private Const riTransp As Integer = 41

Private Const cVip1 As Byte = 34

Private Const rVip1 As Integer = 3

Private Const cVip2 As Byte = 34

Private Const rVip2 As Integer = 4

Private Const cVipInf As Byte = 44

Private Const rVipInf As Integer = 3

Private Const cPredsDolzh As Byte = 17

Private Const rPredsDolzh As Integer = 13

Private Const cChl1Dolzh As Byte = 17

Private Const rChl1Dolzh As Integer = 15

Private Const cChl2Dolzh As Byte = 17

Private Const rChl2Dolzh As Integer = 17

Private Const cPredsName As Byte = 51

Private Const rPredsName As Integer = 13

Private Const cChl1Name As Byte = 51

Private Const rChl1Name As Integer = 15

Private Const cChl2Name As Byte = 51

Private Const rChl2Name As Integer = 17

Private Const cPrinDolzh As Byte = 17

Private Const rPrinDolzh As Integer = 30

Private Const cPrinName As Byte = 51

Private Const rPrinName As Integer = 30

Private Const cDatPrinDay As Byte = 79

Private Const rDatPrinDay As Integer = 30

Private Const cDatPrinMon As Byte = 83

Private Const rDatPrinMon As Integer = 30

Private Const cDatPrinYear As Byte = 96

Private Const rDatPrinYear As Integer = 30

Private Const cSdalDolzh As Byte = 17

Private Const rSdalDolzh As Integer = 22

Private Const cSdalName As Byte = 51

Private Const rSdalName As Integer = 22

Private Const cDatSdalDay As Byte = 79

Private Const rDatSdalDay As Integer = 22

Private Const cDatSdalMon As Byte = 83

Private Const rDatSdalMon As Integer = 22

Private Const cDatSdalYear As Byte = 96

Private Const rDatSdalYear As Integer = 22

Private Const сGlBuch As Byte = 30

Private Const rGlBuch As Integer = 38

Sub PrintFormOS3 (ByVal nomer As Long)

Dim db As Database, Rec As DAO. Recordset, RecList As DAO. Recordset

Dim oApp As Object

Dim StrFormName As String

Dim StrFile As String, s_folder As String, StrPath As String

Dim StrGlBuch As String

Dim StrFirmName As String, StrFirmOKPO As String, StrFirmAddr As String, StrFirmReq As String

Dim NomerVnutr As String, StrDate As Date

Dim StrTovar As String, StrInv As String

Dim StrPasp As String, StrZav As String

Dim StrIsp As String, StrIspOKPO As String

Dim StrOper As String, StrdNomer As String, StrdDate As Date

Dim StrPDate1 As Date, StrPDate2 As Date

Dim StrFDate1 As Date, StrFDate2 As Date

Dim StrRukName As String, StrRukDolzh As String

Dim StrDatePodp As Date

Dim StrOstStoim As Double, StrFaktSrok As Long

Dim StrDemStoim As Double, StrPlRab As Double, StrPlRab2 As Double

Dim StrFtRab As Double, StrFtRab2 As Double, StrTransp As Double

Dim vbVip As Boolean, StrNoVip As String

Dim StrPredsName As String, StrPredsDolzh As String

Dim StrChl1Name As String, StrChl1Dolzh As String

Dim StrChl2Name As String, StrChl2Dolzh As String

Dim StrPrinName As String, StrPrinDolzh As String

Dim StrSdalName As String, StrSdalDolzh As String

Dim StrPrinDate As Date, StrSdalDate As Date

Dim StrMonthPodp As String, StrMonthPrin As String, StrMonthSdal As String

On Error GoTo LblErr

If nomer = 0 Then Exit Sub

s_folder = CurrentProject. Path

If Right$ (s_folder,

1) <> "\" Then s_folder = s_folder + "\"

s_folder = s_folder + "blanks\"

If Len (Dir$ (s_folder, vbDirectory)) = 0 Then

MsgBox "Путь к папке с бланками " & s_folder & " не обнаружен!", vbCritical + vbOKOnly

Exit Sub

End If

Set db = CurrentDb

Set Rec = db. OpenRecordset ("select * from Формы where НомерФорма = " & NomerForm, dbOpenSnapshot)

If Rec. RecordCount > 0 Then

StrFormName = Rec. Fields ("Наименование"). Value

StrFile = Rec. Fields ("Файл"). Value

Else

Set Rec = Nothing

MsgBox "Нет информации о форме №" & NomerForm & "!", vbCritical + vbOKOnly

Exit Sub

End If

Set Rec = Nothing

StrPath = s_folder + StrFile

If Len (Dir$ (StrPath)) = 0 Then

MsgBox "Файл бланка формы '" & StrFormName & "' " & StrPath & " не обнаружен!", vbCritical + vbOKOnly

Exit Sub

End If

Set Rec = db. OpenRecordset ("SELECT Параметры. *, Сотрудники. Сотрудник FROM Сотрудники INNER JOIN Параметры ON Сотрудники. НомерСотр = Параметры. ГлБухгалтер", dbOpenSnapshot)

If Rec. RecordCount > 0 Then

StrFirmName = Nz (Rec. Fields ("НаименованиеФирмы"). Value, "")

StrFirmOKPO = Nz (Rec. Fields ("ОКПО"). Value, "")

StrGlBuch = Nz (Rec. Fields ("Сотрудник"). Value, "")

StrFirmAddr = Nz (Rec. Fields ("ЮрАдрес"). Value, "")

StrFirmReq = Nz (Rec. Fields ("БанкРеквизиты"). Value, "")

Else

MsgBox "Общие параметры фирмы не занесены!", vbCritical + vbOKOnly

Exit Sub

End If

Set Rec = Nothing

Set Rec = db. OpenRecordset ("select * from запрос_АктыРемонта where НомерАктаРемонта = " & nomer, dbOpenSnapshot)

If Rec. RecordCount > 0 Then

NomerVnutr = Nz (Rec. Fields ("НомерВнутр"). Value, nomer)

StrDate = Nz (Rec. Fields ("ДатаАкта"). Value, Date)

StrTovar = Nz (Rec. Fields ("Товар"). Value, "")

StrInv = Nz (Rec. Fields ("ИнвКод"). Value, "")

StrPasp = Nz (Rec. Fields ("НомерПоПаспорту"). Value, "")

StrZav = Nz (Rec. Fields ("НомерЗавод"). Value, "")

StrIsp = Nz (Rec. Fields ("Исполнитель"). Value, "")

StrIspOKPO = Nz (Rec. Fields ("isp_okpo"). Value, "")

StrOper = Nz (Rec. Fields ("ВидРаботы"). Value, "")

StrdNomer = Nz (Rec. Fields ("НомерДоговора"). Value, "")

StrdDate = Nz (Rec. Fields ("ДатаДоговора"). Value, Date)

StrPDate1 = Nz (Rec. Fields ("ПериодРемПлан1"). Value, Date)

StrPDate2 = Nz (Rec. Fields ("ПериодРемПлан2"). Value, Date)

StrFDate1 = Nz (Rec. Fields ("ПериодРемФакт1"). Value, Date)

StrFDate2 = Nz (Rec. Fields ("ПериодРемФакт2"). Value, Date)

StrRukName = Nz (Rec. Fields ("ruk_name"). Value, "")

StrRukDolzh = Nz (Rec. Fields ("ruk_dolzhn"). Value, "")

StrDatePodp = Nz (Rec. Fields ("ДатаПодписи"). Value, Date)

StrOstStoim = Nz (Rec. Fields ("ОстСтоииость"). Value, 0)

StrFaktSrok = Nz (Rec. Fields ("ФактСрокЭкспл"). Value, 0)

StrOper = Nz (Rec. Fields ("ВидРаботы"). Value, "")

StrDemStoim = Nz (Rec. Fields ("СтоимДемонт"). Value, 0)

StrPlRab = Nz (Rec. Fields ("СтоимРаботПлан"). Value, 0)

StrPlRab2 = Nz (Rec. Fields ("СтоимРаботПлан2"). Value, 0)

StrFtRab = Nz (Rec. Fields ("СтоимРаботФакт"). Value, 0)

StrFtRab2 = Nz (Rec. Fields ("СтоимРаботФакт2"). Value, 0)

StrTransp = Nz (Rec. Fields ("СтоимТрансп"). Value, 0)

vbVip = Nz (Rec. Fields ("Полностью"). Value, True)

StrNoVip = Nz (Rec. Fields ("ЧтоНеПолн"). Value, "")

StrPredsName = Nz (Rec. Fields ("preds_name"). Value, "")

StrPredsDolzh = Nz (Rec. Fields ("preds_dolzhn"). Value, "")

StrChl1Name = Nz (Rec. Fields ("chlen1_name"). Value, "")

StrChl1Dolzh = Nz (Rec. Fields ("chlen1_dolzhn"). Value, "")

StrChl2Name = Nz (Rec. Fields ("chlen2_name"). Value, "")

StrChl2Dolzh = Nz (Rec. Fields ("chlen2_dolzhn"). Value, "")

StrPrinName = Nz (Rec. Fields ("prin_name"). Value, "")

StrPrinDolzh = Nz (Rec. Fields ("prin_dolzhn"). Value, "")

StrPrinDate = Nz (Rec. Fields ("ДатаПриемки"). Value, Date)

StrSdalName = Nz (Rec. Fields ("sdal_name"). Value, "")

StrSdalDolzh = Nz (Rec. Fields ("sdal_dolzhn"). Value, "")

StrSdalDate = Nz (Rec. Fields ("ДатаСдачи"). Value, Date)

StrGlBuch = Nz (Rec. Fields ("glbuch_name"). Value, "")

Else

MsgBox "Акт сдачи-приемки отремонт. ОС №" & nomer & " не найден!", vbCritical + vbOKOnly

Exit Sub

End If

Set Rec = Nothing

Set Rec = db. OpenRecordset ("select * from ВспомДата where НомерМес = " & Month (StrDatePodp), dbOpenSnapshot)

If Rec. RecordCount > 0 Then

StrMonthPodp = Nz (Rec. Fields ("НазвМес"). Value, "")

Else

StrMonthPodp = "нет названия"

End If

Set Rec = Nothing

Set Rec = db. OpenRecordset ("select * from ВспомДата where НомерМес = " & Month (StrPrinDate), dbOpenSnapshot)

If Rec. RecordCount > 0 Then

StrMonthPrin = Nz (Rec. Fields ("НазвМес"). Value, "")

Else

StrMonthPrin = "нет названия"

End If

Set Rec = Nothing

Set Rec = db. OpenRecordset ("select * from ВспомДата where НомерМес = " & Month (StrSdalDate), dbOpenSnapshot)

If Rec. RecordCount > 0 Then

StrMonthSdal = Nz (Rec. Fields ("НазвМес"). Value, "")

Else

StrMonthSdal = "нет названия"

End If

Set Rec = Nothing

Set oApp = CreateObject ("Excel. Application")

oApp. Workbooks. Open FileName: =StrPath, ReadOnly: =True

oApp. ActiveWorkbook. Sheets (1). Select

oApp. Cells (rFirmName, cFirmName). Value = StrFirmName

oApp. Cells (rFirmOKPO, cFirmOKPO). Value = StrFirmOKPO

oApp. Cells (rNomer, cNomer). Value = NomerVnutr

oApp. Cells (rDat, cDat). Value = Format$ (StrDate, "dd. mm. yyyy")

oApp. Cells (rIsp, cIsp). Value = StrIsp

oApp. Cells (rIspOKPO, cIspOKPO). Value = StrIspOKPO

oApp. Cells (rdNomer, cdNomer). Value = StrdNomer

oApp. Cells (rdDate, cdDate). Value = Format$ (StrdDate, "dd. mm. yyyy")

oApp. Cells (rPDate1, cPDate1). Value = Format$ (StrPDate1, "dd. mm. yyyy")

oApp. Cells (rPDate2, cPDate2). Value = Format$ (StrPDate2, "dd. mm. yyyy")

oApp. Cells (rFDate1, cFDate1). Value = Format$ (StrFDate1, "dd. mm. yyyy")

oApp. Cells (rFDate2, cFDate2). Value = Format$ (StrFDate2, "dd. mm. yyyy")

oApp. Cells (rRukName, cRukName). Value = StrRukName

oApp. Cells (rRukDolzh, cRukDolzh). Value = StrRukDolzh

oApp. Cells (rDatRukDay, cDatRukDay). Value = Format$ (StrDatePodp, "dd")

oApp. Cells (rDatRukMon, cDatRukMon). Value = StrMonthPodp

oApp. Cells (rDatRukYear, cDatRukYear). Value = Right$ (Format$ (StrDatePodp, "yyyy"),

1)

oApp. Cells (rInv, cInv). Value = StrInv

oApp. Cells (rPasp, cPasp). Value = StrPasp

oApp. Cells (rZav, cZav). Value = StrZav

oApp. Cells (rTovar, cTovar). Value = StrTovar

oApp. Cells (rTovar2, cTovar2). Value = StrTovar

oApp. Cells (rOstStoim, cOstStoim). Value = Format$ (StrOstStoim, "0.00")

oApp. Cells (rFaktSrok, cFaktSrok). Value = StrFaktSrok & "мес."

oApp. Cells (rOper, cOper). Value = StrOper

oApp. Cells (rDemStoim, cDemStoim). Value = Format$ (StrDemStoim, "0.00")

oApp. Cells (rPlRab, cPlRab). Value = Format$ (StrPlRab, "0.00")

oApp. Cells (rPlRab2, cPlRab2). Value = Format$ (StrPlRab2, "0.00")

oApp. Cells (rFtRab, cFtRab). Value = Format$ (StrFtRab, "0.00")

oApp. Cells (rFtRab2, cFtRab2). Value = Format$ (StrFtRab2, "0.00")

oApp. Cells (rTransp, cTransp). Value = Format$ (StrTransp, "0.00")

oApp. Cells (riDemStoim, ciDemStoim). Value = Format$ (StrDemStoim, "0.00")

oApp. Cells (riPlRab, ciPlRab). Value = Format$ (StrPlRab, "0.00")

oApp. Cells (riPlRab2, ciPlRab2). Value = Format$ (StrPlRab2, "0.00")

oApp. Cells (riFtRab, ciFtRab). Value = Format$ (StrFtRab, "0.00")

oApp. Cells (riFtRab2, ciFtRab2). Value = Format$ (StrFtRab2, "0.00")

oApp. Cells (riTransp, ciTransp). Value = Format$ (StrTransp, "0.00")

oApp. ActiveWorkbook. Sheets (2). Select

If vbVip = True Then

oApp. Cells (rVip1, cVip1). Font. Bold = True

oApp. Cells (rVip2, cVip2). Font. Bold = False

oApp. Cells (rVipInf, cVipInf). Value = ""

Else

oApp. Cells (rVip1, cVip1). Font. Bold = False

oApp. Cells (rVip2, cVip2). Font. Bold = True

oApp. Cells (rVipInf, cVipInf). Value = StrNoVip

End If

oApp. Cells (rPredsName, cPredsName). Value = StrPredsName

oApp. Cells (rPredsDolzh, cPredsDolzh). Value = StrPredsDolzh

oApp. Cells (rChl1Name, cChl1Name). Value = StrChl1Name

oApp. Cells (rChl1Dolzh, cChl1Dolzh). Value = StrChl1Dolzh

oApp. Cells (rChl2Name, cChl2Name). Value = StrChl2Name

oApp. Cells (rChl2Dolzh, cChl2Dolzh). Value = StrChl2Dolzh

oApp. Cells (rPrinName, cPrinName). Value = StrPrinName

oApp. Cells (rPrinDolzh, cPrinDolzh). Value = StrPrinDolzh

oApp. Cells (rDatPrinDay, cDatPrinDay). Value = Format$ (StrPrinDate, "dd")

oApp. Cells (rDatPrinMon, cDatPrinMon). Value = StrMonthPrin

oApp. Cells (rDatPrinYear, cDatPrinYear). Value = Right$ (Format$ (StrPrinDate, "yyyy"),

1)

oApp. Cells (rSdalName, cSdalName). Value = StrSdalName

oApp. Cells (rSdalDolzh, cSdalDolzh). Value = StrSdalDolzh

oApp. Cells (rDatSdalDay, cDatSdalDay). Value = Format$ (StrSdalDate, "dd")

oApp. Cells (rDatSdalMon, cDatSdalMon). Value = StrMonthSdal

oApp. Cells (rDatSdalYear, cDatSdalYear). Value = Right$ (Format$ (StrSdalDate, "yyyy"),

1)

oApp. Cells (rGlBuch, сGlBuch). Value = StrGlBuch

ex:

Application. SysCmd acSysCmdRemoveMeter

If Not (oApp Is Nothing) Then oApp. Visible = True

Set Rec = Nothing

Set RecList = Nothing

Set oApp = Nothing

Set db = Nothing

Exit Sub

LblErr:

MsgBox Err. Description, vbCritical + vbOKOnly

GoTo ex

End Sub

Код модуля OS4

Option Compare Database

Option Explicit

Private Const NomerForm As Long = 6

Private Const cFirmName As Byte = 1

Private Const rFirmName As Integer = 7

Private Const cFirmOKPO As Byte = 88

Private Const rFirmOKPO As Integer = 7

Private Const cNomer As Byte = 53

Private Const rNomer As Integer = 23

Private Const cDat As Byte = 65

Private Const rDat As Integer = 23

Private Const cRukDolzh As Byte = 61

Private Const rRukDolzh As Integer = 19

Private Const cRukName As Byte = 85

Private Const rRukName As Integer = 19

Private Const cDatRukDay As Byte = 78

Private Const rDatRukDay As Integer = 23

Private Const cDatRukMon As Byte = 83

Private Const rDatRukMon As Integer = 23

Private Const cDatRukYear As Byte = 96

Private Const rDatRukYear As Integer = 23

Private Const cStruct As Byte = 1

Private Const rStruct As Integer = 9

Private Const cOsn As Byte = 19

Private Const rOsn As Integer = 12

Private Const cDateOsn As Byte = 88

Private Const rDateOsn As Integer = 13

Private Const cNomerOsn As Byte = 88

Private Const rNomerOsn As Integer = 12

Private Const cDateSpis As Byte = 88

Private Const rDateSpis As Integer = 10

Private Const cMatSotr As Byte = 20

Private Const rMatSotr As Integer = 15

Private Const cMatNomer As Byte = 88

Private Const rMatNomer As Integer = 15

Private Const cPri4ina As Byte = 12

Private Const rPri4ina As Integer = 27

Private Const cTovar As Byte = 1

Private Const rTovar As Integer = 38

Private Const cInv As Byte = 20

Private Const rInv As Integer = 38

Private Const cZav As Byte = 30

Private Const rZav As Integer = 38

Private Const cDateVip As Byte = 40

Private Const rDateVip As Integer = 38

Private Const cDatePriem As Byte = 53

Private Const rDatePriem As Integer = 38

Private Const cFaktSrok As Byte = 60

Private Const rFaktSrok As Integer = 38

Private Const cPerv As Byte = 70

Private Const rPerv As Integer = 38

Private Const cAmort As Byte = 80

Private Const rAmort As Integer = 38

Private Const cOstStoim As Byte = 90

Private Const rOstStoim As Integer = 38

Private Const cZakl As Integer = 61

Private Const rZakl1 As Integer = 13

Private Const cZakl2 As Integer = 1

Private Const rZakl2_1 As Integer = 14

Private Const rZakl2_2 As Integer = 15

Private Const nSymbZakl As Byte = 40

Private Const nSymbZakl2 As Byte = 110

Private Const cPredsDolzh As Byte = 17

Private Const rPredsDolzh As Integer = 17

Private Const cChl1Dolzh As Byte = 17

Private Const rChl1Dolzh As Integer = 19

Private Const cChl2Dolzh As Byte = 17

Private Const rChl2Dolzh As Integer = 21

Private Const cPredsName As Byte = 51

Private Const rPredsName As Integer = 17

Private Const cChl1Name As Byte = 51

Private Const rChl1Name As Integer = 19

Private Const cChl2Name As Byte = 51

Private Const rChl2Name As Integer = 21

Private Const сGlBuch As Byte = 30

Private Const rGlBuch As Integer = 40

Private Const rSh1_1 As Integer = 7

Private Const rSh1_2 As Integer = 10

Private Const cKompl As Byte = 1

Private Const cKol As Byte = 30

Sub PrintFormOS4 (ByVal nomer As Long)

Dim db As Database, Rec As DAO. Recordset, RecList As DAO. Recordset

Dim oApp As Object

Dim StrFormName As String

Dim StrFile As String, s_folder As String, StrPath As String

Dim StrGlBuch As String

Dim StrFirmName As String, StrFirmOKPO As String, StrFirmAddr As String, StrFirmReq As String

Dim NomerVnutr As String, StrDate As Date

Dim StrPredsName As String, StrPredsDolzh As String

Dim StrChl1Name As String, StrChl1Dolzh As String

Dim StrChl2Name As String, StrChl2Dolzh As String

Dim StrDatePodp As Date, StrDateSpis As Date

Dim StrOstStoim As Double, StrFaktSrok As Long

Dim StrTovar As String, StrInv As String, StrZav As String

Dim StrRukName As String, StrRukDolzh As String

Dim StrStruct As String

Dim StrOsn As String, StrDateOsn As Date, StrNomerOsn As String

Dim StrMatSotr As String, StrMatNomer As String

Dim StrPri4ina As String

Dim StrDateVip As Date, StrDatePriem As Date

Dim StrPervStoim As Double, StrAmort As Double

Dim StrZakl As String, StrMonthPodp As String

Dim i As Long, NRecord As Long, p As Long

On Error GoTo LblErr

If nomer = 0 Then Exit Sub

s_folder = CurrentProject. Path

If Right$ (s_folder,

1) <> "\" Then s_folder = s_folder + "\"

s_folder = s_folder + "blanks\"

If Len (Dir$ (s_folder, vbDirectory)) = 0 Then

MsgBox "Путь к папке с бланками " & s_folder & " не обнаружен!", vbCritical + vbOKOnly

Exit Sub

End If

Set db = CurrentDb

Set Rec = db. OpenRecordset ("select * from Формы where НомерФорма = " & NomerForm, dbOpenSnapshot)

If Rec. RecordCount > 0 Then

StrFormName = Rec. Fields ("Наименование"). Value

StrFile = Rec. Fields ("Файл"). Value

Else

Set Rec = Nothing

MsgBox "Нет информации о форме №" & NomerForm & "!", vbCritical + vbOKOnly

Exit Sub

End If

Set Rec = Nothing

StrPath = s_folder + StrFile

If Len (Dir$ (StrPath)) = 0 Then

MsgBox "Файл бланка формы '" & StrFormName & "' " & StrPath & " не обнаружен!", vbCritical + vbOKOnly

Exit Sub

End If

Set Rec = db. OpenRecordset ("SELECT Параметры. *, Сотрудники. Сотрудник FROM Сотрудники INNER JOIN Параметры ON Сотрудники. НомерСотр = Параметры. ГлБухгалтер", dbOpenSnapshot)

If Rec. RecordCount > 0 Then

StrFirmName = Nz (Rec. Fields ("НаименованиеФирмы"). Value, "")

StrFirmOKPO = Nz (Rec. Fields ("ОКПО"). Value, "")

StrGlBuch = Nz (Rec. Fields ("Сотрудник"). Value, "")

StrFirmAddr = Nz (Rec. Fields ("ЮрАдрес"). Value, "")

StrFirmReq = Nz (Rec. Fields ("БанкРеквизиты"). Value, "")

Else

MsgBox "Общие параметры фирмы не занесены!", vbCritical + vbOKOnly

Exit Sub

End If

Set Rec = Nothing

Set Rec = db. OpenRecordset ("select * from запрос_АктыСписания where НомерАкт = " & nomer, dbOpenSnapshot)

If Rec. RecordCount > 0 Then

NomerVnutr = Nz (Rec. Fields ("НомерВнутр"). Value, nomer)

StrDate = Nz (Rec. Fields ("ДатаАкта"). Value, Date)

StrTovar = Nz (Rec. Fields ("Товар"). Value, "")

StrInv = Nz (Rec. Fields ("ИнвКод"). Value, "")

StrZav = Nz (Rec. Fields ("НомерЗавод"). Value, "")

StrRukName = Nz (Rec. Fields ("ruk_name"). Value, "")

StrRukDolzh = Nz (Rec. Fields ("ruk_dolzhn"). Value, "")

StrDatePodp = Nz (Rec. Fields ("ДатаПодписи"). Value, Date)

StrDateSpis = Nz (Rec. Fields ("ДатаСписания"). Value, Date)

StrStruct = Nz (Rec. Fields ("СтруктурноеПодразделение"). Value, "")

StrOsn = Nz (Rec. Fields ("Основание"). Value, "")

StrDateOsn = Nz (Rec. Fields ("ДатаОсн"). Value, Date)

StrNomerOsn = Nz (Rec. Fields ("НомерОсн"). Value, "")

StrMatSotr = Nz (Rec. Fields ("mat_name"). Value, "")

StrMatNomer = Nz (Rec. Fields ("mat_nomer"). Value, "")

StrPri4ina = Nz (Rec. Fields ("Причина"). Value, "")

StrDateVip = Nz (Rec. Fields ("ДатаВыпуск"). Value, Date)

StrDatePriem = Nz (Rec. Fields ("ДатаПринятия"). Value, Date)

StrPervStoim = Nz (Rec. Fields ("ПервСтоииость"). Value, 0)

StrAmort = Nz (Rec. Fields ("Аморт"). Value, 0)

StrOstStoim = Nz (Rec. Fields ("ОстСтоииость"). Value, 0)

StrFaktSrok = Nz (Rec. Fields ("ФактСрокЭкспл"). Value, 0)

StrZakl = Nz (Rec. Fields ("Заключение"). Value, "")

StrPredsName = Nz (Rec. Fields ("preds_name"). Value, "")

StrPredsDolzh = Nz (Rec. Fields ("preds_dolzhn"). Value, "")

StrChl1Name = Nz (Rec. Fields ("chlen1_name"). Value, "")

StrChl1Dolzh = Nz (Rec. Fields ("chlen1_dolzhn"). Value, "")

StrChl2Name = Nz (Rec. Fields ("chlen2_name"). Value, "")

StrChl2Dolzh = Nz (Rec. Fields ("chlen2_dolzhn"). Value, "")

StrGlBuch = Nz (Rec. Fields ("glbuch_name"). Value, "")

Else

MsgBox "Акт списания ОС №" & nomer & " не найден!", vbCritical + vbOKOnly

Exit Sub

End If

Set Rec = Nothing

Set Rec = db. OpenRecordset ("select * from ВспомДата where НомерМес = " & Month (StrDatePodp), dbOpenSnapshot)

If Rec. RecordCount > 0 Then

StrMonthPodp = Nz (Rec. Fields ("НазвМес"). Value, "")

Else

StrMonthPodp = "нет названия"

End If

Set Rec = Nothing

Set oApp = CreateObject ("Excel. Application")

oApp. Workbooks. Open FileName: =StrPath, ReadOnly: =True

oApp. ActiveWorkbook. Sheets (1). Select

oApp. Cells (rFirmName, cFirmName). Value = StrFirmName

oApp. Cells (rFirmOKPO, cFirmOKPO). Value = StrFirmOKPO

oApp. Cells (rNomer, cNomer). Value = NomerVnutr

oApp. Cells (rDat, cDat). Value = Format$ (StrDate, "dd. mm. yyyy")

oApp. Cells (rRukName, cRukName). Value = StrRukName

oApp. Cells (rRukDolzh, cRukDolzh). Value = StrRukDolzh

oApp. Cells (rDatRukDay, cDatRukDay). Value = Format$ (StrDatePodp, "dd")

oApp. Cells (rDatRukMon, cDatRukMon). Value = StrMonthPodp

oApp. Cells (rDatRukYear, cDatRukYear). Value = Right$ (Format$ (StrDatePodp, "yyyy"),

1)

oApp. Cells (rStruct, cStruct). Value = StrStruct

oApp. Cells (rOsn, cOsn). Value = StrOsn

oApp. Cells (rDateOsn, cDateOsn). Value = StrDateOsn

oApp. Cells (rNomerOsn, cNomerOsn). Value = StrNomerOsn

oApp. Cells (rDateSpis, cDateSpis). Value = Format$ (StrDateSpis, "dd. mm. yyyy")

oApp. Cells (rMatSotr, cMatSotr). Value = StrMatSotr

oApp. Cells (rMatNomer, cMatNomer). Value = StrMatNomer

oApp. Cells (rPri4ina, cPri4ina). Value = StrOsn

oApp. Cells (rTovar, cTovar). Value = StrTovar

oApp. Cells (rInv, cInv). Value = StrInv

oApp. Cells (rZav, cZav). Value = StrZav

oApp. Cells (rDateVip, cDateVip). Value = Format$ (StrDateVip, "yyyy")

oApp. Cells (rDatePriem, cDatePriem). Value = Format$ (StrDatePriem, "dd. mm. yyyy")

oApp. Cells (rFaktSrok, cFaktSrok). Value = StrFaktSrok & "мес."

oApp. Cells (rPerv, cPerv). Value = Format$ (StrPervStoim, "0.00")

oApp. Cells (rAmort, cAmort). Value = Format$ (StrAmort, "0.00")

oApp. Cells (rOstStoim, cOstStoim). Value = Format$ (StrOstStoim, "0.00")

oApp. ActiveWorkbook. Sheets (2). Select

oApp. Cells (rZakl1, cZakl). Value = Left$ (StrZakl, nSymbZakl)

StrZakl = Mid$ (StrZakl, nSymbZakl + 1)

i = rZakl2_1

While Len (StrZakl) > 0

oApp. Cells (i, cZakl2). Value = Left$ (StrZakl, nSymbZakl2)

StrZakl = Mid$ (StrZakl, nSymbZakl2 + 1)

i = i + 1

If i > rZakl2_2 Then GoTo lb_ex

Wend

lb_ex:

oApp. Cells (rPredsName, cPredsName). Value = StrPredsName

oApp. Cells (rPredsDolzh, cPredsDolzh). Value = StrPredsDolzh

oApp. Cells (rChl1Name, cChl1Name). Value = StrChl1Name

oApp. Cells (rChl1Dolzh, cChl1Dolzh). Value = StrChl1Dolzh

oApp. Cells (rChl2Name, cChl2Name). Value = StrChl2Name

oApp. Cells (rChl2Dolzh, cChl2Dolzh). Value = StrChl2Dolzh

oApp. Cells (rGlBuch, сGlBuch). Value = StrGlBuch

Application. SysCmd acSysCmdInitMeter, "Вывод информации о товарах", 100

Set RecList = db. OpenRecordset ("select * from запрос_АктыСписанияТовары where НомерАкт = " & nomer, dbOpenSnapshot)

NRecord = RecList. RecordCount

If NRecord > 0 Then

RecList. MoveLast

NRecord = RecList. RecordCount

RecList. MoveFirst

i = 0

p = rSh1_1 - 1

While Not RecList. EOF

i = i + 1

p = p + 1

If p > rSh1_2 Then GoTo ex

Application. SysCmd acSysCmdUpdateMeter, i / NRecord * 100

oApp. Cells (p, cKompl). Value = Nz (RecList. Fields ("НаименованиеКомп"). Value, "")

oApp. Cells (p, cKol). Value = Nz (RecList. Fields ("Количество"). Value, 0) & "шт."

RecList. MoveNext

Wend

End If

ex:

Application. SysCmd acSysCmdRemoveMeter

If Not (oApp Is Nothing) Then oApp. Visible = True

Set Rec = Nothing

Set RecList = Nothing

Set oApp = Nothing

Set db = Nothing

Exit Sub

LblErr:

MsgBox Err. Description, vbCritical + vbOKOnly

GoTo ex

End Sub

Код модуля OS6

Option Compare Database

Option Explicit

Private Const NomerForm As Long = 4

Private Const cFirmName As Byte = 1

Private Const rFirmName As Integer = 7

Private Const cFirmOKPO As Byte = 53

Private Const rFirmOKPO As Integer = 7

Private Const cNomer As Byte = 20

Private Const rNomer As Integer = 14

Private Const cDat As Byte = 26

Private Const rDat As Integer = 14

Private Const cTovar As Byte = 6

Private Const rTovar As Integer = 15

Private Const cMest As Byte = 27

Private Const rMest As Integer = 20

Private Const cSchet As Byte = 53

Private Const rSchet As Integer = 18

Private Const cAmort As Byte = 53

Private Const rAmort As Integer = 12

Private Const cInv As Byte = 53

Private Const rInv As Integer = 14

Private Const cDatePriem As Byte = 53

Private Const rDatePriem As Integer = 16

Private Const cDateSpis As Byte = 53

Private Const rDateSpis As Integer = 17

Private Const cPost As Byte = 17

Private Const rPost As Integer = 21

Private Const cPerv As Byte = 53

Private Const rPerv As Integer = 35

Private Const cSrok As Byte = 59

Private Const rSrok As Integer = 35

Private Const cOsn As Byte = 1

Private Const rOsn As Integer = 59

Private Const cOper As Byte = 10

Private Const rOper As Integer = 59

Private Const cStruct As Byte = 19

Private Const rStruct As Integer = 59

Private Const cOstStoim As Byte = 39

Private Const rOstStoim As Integer = 59

Private Const cOtvSotr As Byte = 49

Private Const rOtvSotr As Integer = 59

Private Const cTovar2 As Byte = 1

Private Const rTovar2 As Integer = 19

Private Const cKol As Byte = 32

Private Const rKol As Integer = 19

Private Const cInvDolzh As Byte = 33

Private Const rInvDolzh As Integer = 36

Private Const cInvName As Byte = 67

Private Const rInvName As Integer = 36

Sub PrintFormOS6 (ByVal nomer As Long)

Dim db As Database, Rec As DAO. Recordset, RecList As DAO. Recordset

Dim oApp As Object

Dim StrFormName As String

Dim StrFile As String, s_folder As String, StrPath As String

Dim StrGlBuch As String

Dim StrFirmName As String, StrFirmOKPO As String, StrFirmAddr As String, StrFirmReq As String

Dim StrSchet As String, StrAmot As String

Dim NomerVnutr As String, StrDate As Date

Dim StrTovar As String, StrInv As String

Dim StrStoim As Double, StrOstStoim As Double, StrSroki As Long

Dim StrMest As String, StrKol As Long

Dim StrDatePriem As Date, StrDateSpis As Date

Dim StrPost As String, StrOsn As String, StrOper As String, StrStruct As String

Dim StrOtvSotr As String, StrInvSotr As String, StrInvSotrDolzhn As String

On Error GoTo LblErr

If nomer = 0 Then Exit Sub

s_folder = CurrentProject. Path

If Right$ (s_folder,

1) <> "\" Then s_folder = s_folder + "\"

s_folder = s_folder + "blanks\"

If Len (Dir$ (s_folder, vbDirectory)) = 0 Then

MsgBox "Путь к папке с бланками " & s_folder & " не обнаружен!", vbCritical + vbOKOnly

Exit Sub

End If

Set db = CurrentDb

Set Rec = db. OpenRecordset ("select * from Формы where НомерФорма = " & NomerForm, dbOpenSnapshot)

If Rec. RecordCount > 0 Then

StrFormName = Rec. Fields ("Наименование"). Value

StrFile = Rec. Fields ("Файл"). Value

Else

Set Rec = Nothing

MsgBox "Нет информации о форме №" & NomerForm & "!", vbCritical + vbOKOnly

Exit Sub

End If

Set Rec = Nothing

StrPath = s_folder + StrFile

If Len (Dir$ (StrPath)) = 0 Then

MsgBox "Файл бланка формы '" & StrFormName & "' " & StrPath & " не обнаружен!", vbCritical + vbOKOnly

Exit Sub

End If

Set Rec = db. OpenRecordset ("SELECT Параметры. *, Сотрудники. Сотрудник FROM Сотрудники INNER JOIN Параметры ON Сотрудники. НомерСотр = Параметры. ГлБухгалтер", dbOpenSnapshot)

If Rec. RecordCount > 0 Then

StrFirmName = Nz (Rec. Fields ("НаименованиеФирмы"). Value, "")

StrFirmOKPO = Nz (Rec. Fields ("ОКПО"). Value, "")

StrGlBuch = Nz (Rec. Fields ("Сотрудник"). Value, "")

StrFirmAddr = Nz (Rec. Fields ("ЮрАдрес"). Value, "")

StrFirmReq = Nz (Rec. Fields ("БанкРеквизиты"). Value, "")

Else

MsgBox "Общие параметры фирмы не занесены!", vbCritical + vbOKOnly

Exit Sub

End If

Set Rec = Nothing

Set Rec = db. OpenRecordset ("select * from запрос_ИнвКарты where НомерИнвентКарты = " & nomer, dbOpenSnapshot)

If Rec. RecordCount > 0 Then

StrSchet = Nz (Rec. Fields ("Счет"). Value, "")

StrAmot = Nz (Rec. Fields ("НомерАмортГруппы"). Value, "")

NomerVnutr = Nz (Rec. Fields ("НомерВнутр"). Value, nomer)

StrDate = Nz (Rec. Fields ("ДатаИнвКарты"). Value, Date)

StrTovar = Nz (Rec. Fields ("Товар"). Value, "")

StrInv = Nz (Rec. Fields ("ИнвКод"). Value, "")

StrStoim = Nz (Rec. Fields ("ПервСтоииость"). Value, 0)

StrSroki = Nz (Rec. Fields ("СрокИспользования"). Value, 0)

StrMest = Nz (Rec. Fields ("Местонахождение"). Value, "")

StrKol = Nz (Rec. Fields ("Количество"). Value,

1)

StrDatePriem = Nz (Rec. Fields ("ДатаПринятия"). Value, Date)

StrDateSpis = Nz (Rec. Fields ("ДатаСписания"). Value, Date)

StrPost = Nz (Rec. Fields ("НаименованиеПост"). Value, "")

StrOsn = Nz (Rec. Fields ("ОснованиеПриема"). Value, "")

StrOper = Nz (Rec. Fields ("ВидОперации"). Value, "")

StrStruct = Nz (Rec. Fields ("СтруктурноеПодразделение"). Value, "")

StrOstStoim = Nz (Rec. Fields ("ОстСтоииость"). Value, 0)

StrOtvSotr = Nz (Rec. Fields ("ОтвСотр"). Value, "")

StrInvSotr = Nz (Rec. Fields ("ИнвСотр"). Value, "")

StrInvSotrDolzhn = Nz (Rec. Fields ("Должность"). Value, "")

Else

MsgBox "Инвентарная карточка №" & nomer & " не найдена!", vbCritical + vbOKOnly

Exit Sub

End If

Set Rec = Nothing

Set oApp = CreateObject ("Excel. Application")

oApp. Workbooks. Open FileName: =StrPath, ReadOnly: =True

oApp. ActiveWorkbook. Sheets (1). Select

oApp. Cells (rFirmName, cFirmName). Value = StrFirmName

oApp. Cells (rFirmOKPO, cFirmOKPO). Value = StrFirmOKPO

oApp. Cells (rNomer, cNomer). Value = NomerVnutr

oApp. Cells (rDat, cDat). Value = Format$ (StrDate, "dd. mm. yyyy")

oApp. Cells (rTovar, cTovar). Value = StrTovar

oApp. Cells (rMest, cMest). Value = StrMest

oApp. Cells (rSchet, cSchet). Value = StrSchet

oApp. Cells (rAmort, cAmort). Value = StrAmot

oApp. Cells (rInv, cInv). Value = StrInv

oApp. Cells (rDatePriem, cDatePriem). Value = Format$ (StrDatePriem, "dd. mm. yyyy")

oApp. Cells (rDateSpis, cDateSpis). Value = Format$ (StrDateSpis, "dd. mm. yyyy")

oApp. Cells (rPost, cPost). Value = StrPost

oApp. Cells (rPerv, cPerv). Value = Format$ (StrStoim, "0.00")

oApp. Cells (rSrok, cSrok). Value = StrSroki & " мес."

oApp. Cells (rOsn, cOsn). Value = StrOsn

oApp. Cells (rOper, cOper). Value = StrOper

oApp. Cells (rStruct, cStruct). Value = StrStruct

oApp. Cells (rOstStoim, cOstStoim). Value = Format$ (StrOstStoim, "0.00")

oApp. Cells (rOtvSotr, cOtvSotr). Value = StrOtvSotr

oApp. ActiveWorkbook. Sheets (2). Select

oApp. Cells (rTovar2, cTovar2). Value = StrTovar

oApp. Cells (rKol, cKol). Value = StrKol & " шт."

oApp. Cells (rInvDolzh, cInvDolzh). Value = StrInvSotrDolzhn

oApp. Cells (rInvName, cInvName). Value = StrInvSotr

ex:

Application. SysCmd acSysCmdRemoveMeter

If Not (oApp Is Nothing) Then oApp. Visible = True

Set Rec = Nothing

Set RecList = Nothing

Set oApp = Nothing

Set db = Nothing

Exit Sub

LblErr:

MsgBox Err. Description, vbCritical + vbOKOnly

GoTo ex

End Sub

Код модуля OS6b

Option Compare Database

Option Explicit

Private Const NomerForm As Long = 7

Private Const cFirmName As Byte = 1

Private Const rFirmName As Integer = 7

Private Const cFirmOKPO As Byte = 88

Private Const rFirmOKPO As Integer = 7

Private Const cStruct As Byte = 1

Private Const rStruct As Integer = 9

Private Const cDat1Day As Byte = 30

Private Const rDat1Day As Integer = 23

Private Const cDat1Mon As Byte = 34

Private Const rDat1Mon As Integer = 23

Private Const cDat1Year As Byte = 49

Private Const rDat1Year As Integer = 23

Private Const cDat2Day As Byte = 57

Private Const rDat2Day As Integer = 23

Private Const cDat2Mon As Byte = 61

Private Const rDat2Mon As Integer = 23

Private Const cDat2Year As Byte = 76

Private Const rDat2Year As Integer = 23

Private Const cInvName As Byte = 48

Private Const rInvName As Integer = 33

Private Const cInvDolzhn As Byte = 24

Private Const rInvDolzhn As Integer = 33

Private Const cInvNomer As Byte = 88

Private Const rInvNomer As Integer = 33

Private Const rSh1_1 As Integer = 8

Private Const rSh1_2 As Integer = 35

Private Const cNomer As Byte = 1

Private Const cTovar As Byte = 5

Private Const cInv As Byte = 20

Private Const cOsn As Byte = 30

Private Const cDatePrin As Byte = 43

Private Const cStructTov As Byte = 52

Private Const cOtv As Byte = 61

Private Const cPervStoim As Byte = 70

Private Const cSrok As Byte = 80

Private Const cAmort As Byte = 90

Private Const cOstStoim As Byte = 1

Sub PrintFormOS6b (ByVal v_dat1 As Date, _

ByVal v_dat2 As Date, _

ByVal nomer_struct As Long, ByVal StrStruct As String)

Dim db As Database, qry As DAO. QueryDef, Rec As DAO. Recordset, RecList As DAO. Recordset

Dim oApp As Object

Dim StrFormName As String

Dim StrFile As String, s_folder As String, StrPath As String

Dim StrFirmName As String, StrFirmOKPO As String

Dim StrInvOtvName As String, StrInvOtvDolzhn As String, StrInvOtvNomer As String

Dim StrMonth1 As String, StrMonth2 As String

Dim i As Long, NRecord As Long, p As Long

On Error GoTo LblErr

s_folder = CurrentProject. Path

If Right$ (s_folder,

1) <> "\" Then s_folder = s_folder + "\"

s_folder = s_folder + "blanks\"

If Len (Dir$ (s_folder, vbDirectory)) = 0 Then

MsgBox "Путь к папке с бланками " & s_folder & " не обнаружен!", vbCritical + vbOKOnly

Exit Sub

End If

Set db = CurrentDb

Set Rec = db. OpenRecordset ("select * from Формы where НомерФорма = " & NomerForm, dbOpenSnapshot)

If Rec. RecordCount > 0 Then

StrFormName = Rec. Fields ("Наименование"). Value

StrFile = Rec. Fields ("Файл"). Value

Else

Set Rec = Nothing

MsgBox "Нет информации о форме №" & NomerForm & "!", vbCritical + vbOKOnly

Exit Sub

End If

Set Rec = Nothing

StrPath = s_folder + StrFile

If Len (Dir$ (StrPath)) = 0 Then

MsgBox "Файл бланка формы '" & StrFormName & "' " & StrPath & " не обнаружен!", vbCritical + vbOKOnly

Exit Sub

End If

Set Rec = db. OpenRecordset ("SELECT Параметры. *, Сотрудники. Сотрудник, Сотрудники. ТабельныйНомер, Должности. Должность FROM ( (Должности RIGHT JOIN Сотрудники ON Должности. НомерДолжн = Сотрудники. НомерДолжн) RIGHT JOIN Параметры ON Сотрудники. НомерСотр = Параметры. ИнвОтвеств)", dbOpenSnapshot)

If Rec. RecordCount > 0 Then

StrFirmName = Nz (Rec. Fields ("НаименованиеФирмы"). Value, "")

StrFirmOKPO = Nz (Rec. Fields ("ОКПО"). Value, "")

StrInvOtvName = Nz (Rec. Fields ("Сотрудник"). Value, "")

StrInvOtvDolzhn = Nz (Rec. Fields ("Должность"). Value, "")

StrInvOtvNomer = Nz (Rec. Fields ("ТабельныйНомер"). Value, "")

Else

MsgBox "Общие параметры фирмы не занесены!", vbCritical + vbOKOnly

Exit Sub

End If

Set Rec = Nothing

Set Rec = db. OpenRecordset ("select * from ВспомДата where НомерМес = " & Month (v_dat1), dbOpenSnapshot)

If Rec. RecordCount > 0 Then

StrMonth1 = Nz (Rec. Fields ("НазвМес"). Value, "")

Else

StrMonth1 = "нет названия"

End If

Set Rec = Nothing

Set Rec = db. OpenRecordset ("select * from ВспомДата where НомерМес = " & Month (v_dat2), dbOpenSnapshot)

If Rec. RecordCount > 0 Then

StrMonth2 = Nz (Rec. Fields ("НазвМес"). Value, "")

Else

StrMonth2 = "нет названия"

End If

Set Rec = Nothing

Set oApp = CreateObject ("Excel. Application")

oApp. Workbooks. Open FileName: =StrPath, ReadOnly: =True

oApp. ActiveWorkbook. Sheets (1). Select

oApp. Cells (rFirmName, cFirmName). Value = StrFirmName

oApp. Cells (rFirmOKPO, cFirmOKPO). Value = StrFirmOKPO

oApp. Cells (rStruct, cStruct). Value = StrStruct

oApp. Cells (rDat1Day, cDat1Day). Value = Format$ (v_dat1, "dd")

oApp. Cells (rDat1Mon, cDat1Mon). Value = StrMonth1

oApp. Cells (rDat1Year, cDat1Year). Value = Right$ (Format$ (v_dat1, "yyyy"),

1)

oApp. Cells (rDat2Day, cDat2Day). Value = Format$ (v_dat2, "dd")

oApp. Cells (rDat2Mon, cDat2Mon). Value = StrMonth2

oApp. Cells (rDat2Year, cDat2Year). Value = Right$ (Format$ (v_dat2, "yyyy"),

1)

oApp. Cells (rInvName, cInvName). Value = StrInvOtvName

oApp. Cells (rInvDolzhn, cInvDolzhn). Value = StrInvOtvDolzhn

oApp. Cells (rInvNomer, cInvNomer). Value = StrInvOtvNomer

Application. SysCmd acSysCmdInitMeter, "Вывод информации о товарах", 100

If nomer_struct = 0 Then

Set qry = db. QueryDefs ("запрос_ИнвКнига2")

qry. Parameters (0) = v_dat1

qry. Parameters (1) = v_dat2

Else

Set qry = db. QueryDefs ("запрос_ИнвКнига")

qry. Parameters (0) = v_dat1

qry. Parameters (1) = nomer_struct

qry. Parameters (2) = v_dat2

End If

Set RecList = qry. OpenRecordset (dbOpenSnapshot)

NRecord = RecList. RecordCount

If NRecord > 0 Then

RecList. MoveLast

NRecord = RecList. RecordCount

RecList. MoveFirst

i = 0

p = rSh1_1 - 1

While Not RecList. EOF

i = i + 1

p = p + 1

If p > rSh1_2 Then GoTo ex

Application. SysCmd acSysCmdUpdateMeter, i / NRecord * 100

With oApp. ActiveWorkbook. Sheets (2)

. Cells (p, cNomer). Value = i

. Cells (p, cTovar). Value = Nz (RecList. Fields ("Наименование"). Value, "")

. Cells (p, cInv). Value = Nz (RecList. Fields ("ИнвНомер"). Value, "")

. Cells (p, cOsn). Value = Nz (RecList. Fields ("ОснованиеПринятия"). Value, "")

. Cells (p, cDatePrin). Value = Format$ (Nz (RecList. Fields ("ДатаПринятияКУчету"). Value, Date), "dd. mm. yyyy")

. Cells (p, cStructTov). Value = Nz (RecList. Fields ("СтруктурноеПодразделение"). Value, "")

. Cells (p, cOtv). Value = Nz (RecList. Fields ("Сотрудник"). Value, "")

. Cells (p, cPervStoim). Value = Nz (RecList. Fields ("ПервСтоииость"). Value, 0)

. Cells (p, cSrok). Value = Nz (RecList. Fields ("СрокИспользования"). Value, 0) & "мес."

. Cells (p, cAmort). Value = Nz (RecList. Fields ("Аморт"). Value, 0)

End With

oApp. ActiveWorkbook. Sheets (3). Cells (p, cOstStoim). Value = _

Nz (RecList. Fields ("ОстСтоииость"). Value, 0)

RecList. MoveNext

Wend

End If

ex:

Application. SysCmd acSysCmdRemoveMeter

If Not (oApp Is Nothing) Then oApp. Visible = True

Set qry = Nothing

Set RecList = Nothing

Set oApp = Nothing

Set db = Nothing

Exit Sub

LblErr:

MsgBox Err. Description, vbCritical + vbOKOnly

GoTo ex

End Sub

Код модуля общий

Option Compare Database

Option Explicit

Function translateNumber (ByVal Num As Long) As String

On Error GoTo LblErr

Dim num_str As String

Dim razr_count As Long

Dim razr_all As Long

Dim tri_count As Long

Dim tri_all As Long

Dim cur_dig As Byte

Dim point_pos As Long

Dim mg As Boolean

Dim mgl As Boolean

Dim kstr1 As Long

translateNumber = ""

num_str = Trim (Str (Num))

tri_count = 1

razr_all = Len (num_str)

If razr_all = 0 Then

translateNumber = "ноль"

Exit Function

End If

If Num = 0 Then

translateNumber = "ноль"

Exit Function

End If

For razr_count = 1 To razr_all Step 3

kstr1 = Mid (num_str, razr_all - razr_count + 1,1)

If razr_count = 1 Then mgl = True

If razr_count = 4 Then

mgl = True

If razr_count >= razr_all Then GoTo m1

If Mid (num_str, razr_all - razr_count,

1) = "1" Then

translateNumber = " тысяч" & translateNumber

Else

m1: If kstr1 = "1" Then translateNumber = " тысяча" & translateNumber

If kstr1 = "2" Then translateNumber = " тысячи" & translateNumber

If kstr1 = "3" Then translateNumber = " тысячи" & translateNumber

If kstr1 = "4" Then translateNumber = " тысячи" & translateNumber

If (Val (kstr1) >= 5) Or (kstr1 = "0") Then translateNumber = " тысяч" & translateNumber

End If

End If

If razr_count = 7 Then

mgl = False

If kstr1 = "1" Then translateNumber = " миллион" & translateNumber

If kstr1 = "2" Then translateNumber = " миллиона" & translateNumber

If kstr1 = "3" Then translateNumber = " миллиона" & translateNumber

If kstr1 = "4" Then translateNumber = " миллиона" & translateNumber

If (Val (kstr1) >= 5) Or (kstr1 = "0") Then translateNumber = " миллионов" & translateNumber

End If

If razr_count = 10 Then

mgl = False

If kstr1 = "1" Then translateNumber = " миллиард" & translateNumber

If kstr1 = "2" Then translateNumber = " миллиарда" & translateNumber

If kstr1 = "3" Then translateNumber = " миллиарда" & translateNumber

If kstr1 = "4" Then translateNumber = " миллиарда" & translateNumber

If (Val (kstr1) >= 5) Or (kstr1 = "0") Then translateNumber = " миллиардов" & translateNumber

End If

If razr_count = 13 Then

mgl = False

If kstr1 = "1" Then translateNumber = " триллион" & translateNumber

If kstr1 = "2" Then translateNumber = " триллиона" & translateNumber

If kstr1 = "3" Then translateNumber = " триллиона" & translateNumber

If kstr1 = "4" Then translateNumber = " триллиона" & translateNumber

If (Val (kstr1) >= 5) Or (kstr1 = "0") Then translateNumber = " триллионов" & translateNumber

End If

If razr_all - razr_count - 1 < 1 Then

translateNumber = triade (Mid (num_str, 1, razr_all - razr_count + 1), mgl) & translateNumber

Else

translateNumber = triade (Mid (num_str, razr_all - razr_count - 1,3), mgl) & translateNumber

End If

Next razr_count

translateNumber = ucasefirst (translateNumber)

Exit Function

LblErr:

MsgBox Err. Description

End Function

Function triade (ByVal in_str As String, mg As Boolean) As String

On Error GoTo LblErr

Dim out_tri2 As String

Dim out_tri1 As String

Dim out_tri3 As String

Dim di As String, kstr1 As String

triade = ""

If Len (in_str) < 3 Then in_str = "0" & in_str

If Len (in_str) < 3 Then in_str = "0" & in_str

kstr1 = Mid (in_str, 1,1)

If kstr1 = "0" Then out_tri3 = ""

If kstr1 = "1" Then out_tri3 = " сто"

If kstr1 = "2" Then out_tri3 = " двести"

If kstr1 = "3" Then out_tri3 = " триста"

If kstr1 = "4" Then out_tri3 = " четыреста"

If kstr1 = "5" Then out_tri3 = " пятьсот"

If kstr1 = "6" Then out_tri3 = " шестьсот"

If kstr1 = "7" Then out_tri3 = " семьсот"

If kstr1 = "8" Then out_tri3 = " восемьсот"

If kstr1 = "9" Then out_tri3 = " девятьсот"

'оцениваем на 11

di = Right (in_str,

2): kstr1 = Mid (in_str, 2,1)

If kstr1 = "1" Then

If di = "10" Then out_tri2 = " десять"

If di = "11" Then out_tri2 = " одиннадцать"

If di = "12" Then out_tri2 = " двенадцать"

If di = "13" Then out_tri2 = " тринадцать"

If di = "14" Then out_tri2 = " четырнадцать"

If di = "15" Then out_tri2 = " пятнадцать"

If di = "16" Then out_tri2 = " шестнадцать"

If di = "17" Then out_tri2 = " семнадцать"

If di = "18" Then out_tri2 = " восемнадцать"

If di = "19" Then out_tri2 = " девятнадцать"

triade = out_tri3 & out_tri2

Exit Function

End If

If kstr1 = "0" Then out_tri2 = ""

If kstr1 = "2" Then out_tri2 = " двадцать"

If kstr1 = "3" Then out_tri2 = " тридцать"

If kstr1 = "4" Then out_tri2 = " сорок"

If kstr1 = "5" Then out_tri2 = " пятьдесят"

If kstr1 = "6" Then out_tri2 = " шестьдесят"

If kstr1 = "7" Then out_tri2 = " семдесят"

If kstr1 = "8" Then out_tri2 = " восемдесят"

If kstr1 = "9" Then out_tri2 = " девяносто"

kstr1 = Mid (in_str, 3,1)

If kstr1 = "0" Then out_tri1 = ""

If mg = False Then

If kstr1 = "1" Then out_tri1 = " один"

If kstr1 = "2" Then out_tri1 = " два"

Else

If kstr1 = "1" Then out_tri1 = " одна"

If kstr1 = "2" Then out_tri1 = " две"

End If

If kstr1 = "3" Then out_tri1 = " три"

If kstr1 = "4" Then out_tri1 = " четыре"

If kstr1 = "5" Then out_tri1 = " пять"

If kstr1 = "6" Then out_tri1 = " шесть"

If kstr1 = "7" Then out_tri1 = " семь"

If kstr1 = "8" Then out_tri1 = " восемь"

If kstr1 = "9" Then out_tri1 = " девять"

triade = out_tri3 & out_tri2 & out_tri1

Exit Function

LblErr:

MsgBox Err. Description, vbCritical + vbOKOnly

End Function

Function ucasefirst (in_str As String) As String

On Error GoTo LblErr

Dim fs As String

Dim ns As String

If Nz (in_str, "") = "" Then ucasefirst = ""

in_str = Trim (in_str)

fs = Left (in_str,

1)

ns = Right (in_str, Len (in_str) - 1)

ucasefirst = UCase (fs) & ns

Exit Function

LblErr:

MsgBox Err. Description, vbCritical + vbOKOnly

End Function

Страницы: 1, 2, 3, 4


© 2010 РЕФЕРАТЫ