Автор: Пользователь скрыл имя, 10 Июня 2014 в 22:50, дипломная работа
В данном дипломном проекте была решена задача по автоматизации учета основных средств на предприятии ООО "Алеф". В качестве основы для автоматизации был выбран и сконфигурирован под нужды предприятия комплекс УСН 1С Бухгалтерия. Второй частью создания АРМ бухгалтера была разработка отдельного программного блока для формирования унифицированных форм учета основных средств предприятия. Программный блок был разработан в СУБД MS Access, что позволяет автономно быстро и легко формировать унифицированные формы документов. Основными плюсами разработанного модуля является его относительная автономность, низкая экономическая затратность, легкость с точки зрения технологической установки, а также широкие возможности по дальнейшему усовершенствованию. Проведена предварительная работа по подбору технических средств реализации блока, проанализирована и доказана его экономическая окупаемость. Продумана дальнейшая оптимизация бухгалтерского документооборота и учета на предприятии "Алеф" - добавление полной его интеграции с экспортными данными из программного комплекса УСН 1С Бухгалтерии 7.7.
РЕФЕРАТ
ВВЕДЕНИЕ
1. АНАЛИТИЧЕСКАЯ ЧАСТЬ
1.1 ОРГАНИЗАЦИОННО-ЭКОНОМИЧЕСКАЯ ХАРАКТЕРИСТИКА ПРЕДМЕТНОЙ ОБЛАСТИ. КРАТКОЕ ОПИСАНИЕ КОМПАНИИ ООО "АЛЕФ", АНАЛИЗ АДМИНИСТРАТИВНОЙ И ХОЗЯЙСТВЕННОЙ ДЕЯТЕЛЬНОСТИ ПРЕДПРИЯТИЯ
1.1.1 ОРГАНИЗАЦИОННАЯ СТРУКТУРА ОБЪЕКТА УПРАВЛЕНИЯ
1.1.2 ФУНКЦИОНАЛЬНАЯ ХАРАКТЕРИСТИКА ОБЪЕКТА УПРАВЛЕНИЯ
1.1.3 ЭКОНОМИЧЕСКАЯ ХАРАКТЕРИСТИКА ПРЕДМЕТНОЙ ОБЛАСТИ
1.2 ЭКОНОМИЧЕСКАЯ СУЩНОСТЬ КОМПЛЕКСА ЭКОНОМИЧЕСКИХ ИНФОРМАЦИОННЫХ ЗАДАЧ. РЕАЛИЗАЦИЯ ЭКОНОМИЧЕСКОЙ МОДЕЛИ ПРЕДПРИЯТИЯ С ПОМОЩЬЮ УЧЕТНОЙ СИСТЕМЫ 1С УCН
1.2.1 ОБЩИЕ СВЕДЕНИЯ О ЗАДАЧАХ. ОПИСАНИЕ ИМЕЮЩЕЙСЯ УЧЕТНОЙ СХЕМЫ ПРЕДПРИЯТИЯ В РАМКАХ УСН 1С
1.2.2 ОБОСНОВАНИЕ ВЫБОРА ЗАДАЧ, ВХОДЯЩИХ В КОМПЛЕКС. ПРЕИМУЩЕСТВА ОСНОВНОЙ УЧЕТНОЙ СИСТЕМЫ 1С УСН, А ТАКЖЕ НЕДОСТАЮЩИЕ ЗВЕНЬЯ АВТОМАТИЗИРОВАННОГО УЧЕТА
1.2.3 СПОСОБЫ РЕШЕНИЯ ЗАДАЧИ. ОБЩАЯ МОДЕЛЬ ПОДБОРА РЕШЕНИЯ
1.3 ОБОСНОВАНИЕ ПРОЕКТНЫХ РЕШЕНИЙ ПО АВТОМАТИЗИРОВАННОМУ РЕШЕНИЮ ЭКОНОМИКО-ИНФОРМАЦИОННЫХ ЗАДАЧ. ОСНОВНЫЕ МОМЕНТЫ АВТОМАТИЗАЦИИ УЧЕТА ДЕЯТЕЛЬНОСТИ ПРЕДПРИЯТИЯ. РЕШЕНИЕ НАШИХ ЗАДАЧ С ТОЧКИ ЗРЕНИЯ АВТОМАТИЗАЦИИ УЧЕТА НА ПРЕДПРИЯТИИ
1.3.1 ОБОСНОВАНИЕ ПРОЕКТНЫХ РЕШЕНИЙ ПО ИНФОРМАЦИОННОМУ ОБЕСПЕЧЕНИЮ КОМПЛЕКСА ЗАДАЧ. ПОДБОР ИНФОРМАЦИОННОГО ОБЕСПЕЧЕНИЯ ДЛЯ БЛОКА РАБОТЫ С УНИФИЦИРОВАННЫМИ ФОРМАМИ
1.3.2 ОБОСНОВАНИЕ ПРОЕКТНЫХ РЕШЕНИЙ ПО ТЕХНОЛОГИИ СБОРА, ПЕРЕДАЧИ, ОБРАБОТКИ И ВЫДАЧИ ИНФОРМАЦИИ. РЕАЛИЗАЦИЯ НЕДОСТАЮЩЕГО В УСН БЛОКА РАБОТЫ С УНИФИЦИРОВАННЫМИ ФОРМАМИ
1.3.3 ОБОСНОВАНИЕ ПРОЕКТНЫХ РЕШЕНИЙ ПО ПРОГРАММНОМУ ОБЕСПЕЧЕНИЮ КОМПЛЕКСА ЗАДАЧ
1.3.4 ОБОСНОВАНИЕ НЕОБХОДИМОСТИ ИСПОЛЬЗОВАНИЯ ВЫЧИСЛИТЕЛЬНОЙ ТЕХНИКИ И СОЗДАНИЯ АРМ ДЛЯ РЕШЕНИЯ ДАННОГО КОМПЛЕКСА ЗАДАЧ
2. ПРОЕКТНАЯ ЧАСТЬ
2.1 ИНФОРМАЦИОННОЕ ОБЕСПЕЧЕНИЕ КОМПЛЕКСА ЗАДАЧ
2.1.1 ИНФОЛОГИЧЕСКАЯ (ИНФОРМАЦИОННАЯ) МОДЕЛЬ (СХЕМА ДАННЫХ) И ЕЕ ОПИСАНИЕ
2.1.2 ИСПОЛЬЗУЕМЫЕ КЛАССИФИКАТОРЫ И СИСТЕМЫ КОДИРОВАНИЯ
2.1.3 ХАРАКТЕРИСТИКА ВХОДНОЙ ИНФОРМАЦИИ
2.1.4 НОРМАТИВНО-СПРАВОЧНАЯ ИНФОРМАЦИЯ
2.1.5 ХАРАКТЕРИСТИКА РЕЗУЛЬТАТНОЙ ИНФОРМАЦИИ
2.2 ВНУТРИМАШИННАЯ РЕАЛИЗАЦИЯ КОМПЛЕКСА ЗАДАЧ
2.2.1 ФОРМАЛИЗАЦИЯ РАСЧЕТОВ (АЛГОРИТМЫ РАСЧЕТА И РЕШЕНИЯ ЗАДАЧ)
2.2.2 СТРУКТУРНАЯ СХЕМА ИСПОЛЬЗОВАНИЯ КОМПЛЕКСА ПРОГРАММ (ДЕРЕВО ДИАЛОГА). ВЗАИМОДЕЙСТВИЕ УСН С БЛОКОМ ФОРМИРОВАНИЯ УНИФИЦИРОВАННЫХ ФОРМ
2.2.3 ОПИСАНИЕ ИНТЕРФЕЙСА ПРИЛОЖЕНИЯ.
2.3.1 ОРГАНИЗАЦИЯ ТЕХНОЛОГИИ СБОРА, ПЕРЕДАЧИ, ОБРАБОТКИ И ВЫДАЧИ ИНФОРМАЦИИ
2.3.2 СХЕМА ТЕХНОЛОГИЧЕСКОГО ПРОЦЕССА СБОРА, ПЕРЕДАЧИ, ОБРАБОТКИ И ВЫДАЧИ ИНФОРМАЦИИ
2.4 ПРОГРАММНОЕ ОБЕСПЕЧЕНИЕ КОМПЛЕКСА ЗАДАЧ
2.4.1 ОБЩИЕ ПОЛОЖЕНИЯ
2.4.2 СТРУКТУРНАЯ СХЕМА ПАКЕТА (ДЕРЕВО ВЫЗОВА ПРОЦЕДУР И ПРОГРАММ). ОПИСАНИЕ ПРОГРАММНЫХ МОДУЛЕЙ
2.5 СХЕМА ВЗАИМОСВЯЗИ ПРОГРАММНЫХ МОДУЛЕЙ И ИНФОРМАЦИОННЫХ ФАЙЛОВ
2.6 ВЫБОР И ОБОСНОВАНИЕ ТЕХНИЧЕСКИХ СРЕДСТВ
2.7 ЭКОНОМИЧЕСКОЕ ОБОСНОВАНИЕ ПРОЕКТА
ЗАКЛЮЧЕНИЕ
СПИСОК ИСПОЛЬЗОВАННЫХ ИСТОЧНИКОВ
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, "")