Информатика

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

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

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

Set Rec = Nothing

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

Set Rec = Nothing

StrPath = s_folder + StrFile

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

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

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, "")

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

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, "")

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

Set Rec = Nothing

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

If Rec. RecordCount > 0 Then

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

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

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)

While Len (StrZakl) > 0

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

StrZakl = Mid$ (StrZakl, nSymbZakl2 + 1)

If i > rZakl2_2 Then GoTo 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

While Not RecList. EOF

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

Application. SysCmd acSysCmdRemoveMeter

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

Set Rec = Nothing

Set RecList = Nothing

Set oApp = Nothing

Set db = Nothing

MsgBox Err. Description, vbCritical + vbOKOnly

Код модуля 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

читать дальше

26