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

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

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

Exit Sub

End If

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

ot)

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

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