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

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

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