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

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

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