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

Private Const rChl1Dolzh As Integer = 15

Private Const cChl2Dolzh As Byte = 19

Private Const rChl2Dolzh As Integer = 17

Private Const cChl3Dolzh As Byte = 19

Private Const rChl3Dolzh As Integer = 19

Private Const cPredsName As Byte = 60

Private Const rPredsName As Integer = 13

Private Const cChl1Name As Byte = 60

Private Const rChl1Name As Integer = 15

Privat

e Const cChl2Name As Byte = 60

Private Const rChl2Name As Integer = 17

Private Const cChl3Name As Byte = 60

Private Const rChl3Name As Integer = 19

Private Const c2MatDolzhn1 As Byte = 42

Private Const r2MatDolzhn1 As Integer = 26

Private Const c2MatDolzhn2 As Byte = 42

Private Const r2MatDolzhn2 As Integer = 28

Private Const c2MatDolzhn3 As Byte = 42

Private Const r2MatDolzhn3 As Integer = 30

Private Const c2MatName1 As Byte = 79

Private Const r2MatName1 As Integer = 26

Private Const c2MatName2 As Byte = 79

Private Const r2MatName2 As Integer = 28

Private Const c2MatName3 As Byte = 79

Private Const r2MatName3 As Integer = 30

Private Const cDatPodpDay As Byte = 43

Private Const rDatPodpDay As Integer = 33

Private Const cDatPodpMon As Byte = 47

Private Const rDatPodpMon As Integer = 33

Private Const cDatPodpYear As Byte = 63

Private Const rDatPodpYear As Integer = 33

Private Const cDatProvDay As Byte = 41

Private Const rDatProvDay As Integer = 38

Private Const cDatProvMon As Byte = 45

Private Const rDatProvMon As Integer = 38

Private Const cDatProvYear As Byte = 61

Private Const rDatProvYear As Integer = 38

Sub PrintFormInv (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, StrStruct As String

Dim NomerVnutr As String, StrDate As Date

Dim StrOsn As String, StrDateOsn As Date, StrNomerOsn As String

Dim StrMest As String

Dim StrDate1 As Date, StrDate2 As Date

Dim StrMatDolzhn1 As String, StrMatDolzhn2 As String, StrMatDolzhn3 As String

Dim StrMatName1 As String, StrMatName2 As String, StrMatName3 As String

Dim StrPredsName As String, StrPredsDolzh As String

Dim StrChl1Name As String, StrChl1Dolzh As String

Dim StrChl2Name As String, StrChl2Dolzh As String

Dim StrChl3Name As String, StrChl3Dolzh As String

Dim StrProvName As String, StrProvDolzh As String

Dim StrDatePodp As Date, StrDateProv As Date

Dim StrItog As Double, StrItogKol As Long

Dim s_Sum As Double, s_Kol As Long

Dim i As Long, NRecord As Long, p As Long

Dim StrMonthPodp As String, StrMonthProv 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 Параметры", dbOpenSnapshot)

If Rec. RecordCount > 0 Then

StrFirmName = Nz (Rec. Fields ("НаименованиеФирмы"). Value, "")

StrFirmOKPO = 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)

StrOsn = Nz (Rec. Fields ("Основание"). Value, "")

StrDateOsn = Nz (Rec. Fields ("ДатаОсн"). Value, Date)

StrNomerOsn = Nz (Rec. Fields ("НомерОсн"). Value, "")

StrMest = Nz (Rec. Fields ("Местонахождение"). Value, "")

StrStruct = Nz (Rec. Fields ("СтруктурноеПодразделение"). Value, "")

StrDate1 = Nz (Rec. Fields ("ДатаНачала"). Value, Date)

StrDate2 = Nz (Rec. Fields ("ДатаКонца"). Value, Date)

StrMatDolzhn1 = Nz (Rec. Fields ("mat_dolzhn1"). Value, "")

StrMatDolzhn2 = Nz (Rec. Fields ("mat_dolzhn2"). Value, "")

StrMatDolzhn3 = Nz (Rec. Fields ("mat_dolzhn3"). Value, "")

StrMatName1 = Nz (Rec. Fields ("mat_Name1"). Value, "")

StrMatName2 = Nz (Rec. Fields ("mat_Name2"). Value, "")

StrMatName3 = Nz (Rec. Fields ("mat_Name3"). Value, "")

StrPredsName = Nz (Rec. Fields ("preds_name"). Value, "")

StrPredsDolzh = Nz (Rec. Fields ("preds_dolzhn"). Value, "")

StrChl1Name = Nz (Rec. Fields ("chl1_name"). Value, "")

StrChl1Dolzh = Nz (Rec. Fields ("chl1_dolzhn"). Value, "")

StrChl2Name = Nz (Rec. Fields ("chl2_name"). Value, "")

StrChl2Dolzh = Nz (Rec. Fields ("chl2_dolzhn"). Value, "")

StrChl3Name = Nz (Rec. Fields ("chl3_name"). Value, "")

StrChl3Dolzh = Nz (Rec. Fields ("chl3_dolzhn"). Value, "")

StrProvName = Nz (Rec. Fields ("prov_name"). Value, "")

StrProvDolzh = Nz (Rec. Fields ("prov_dolzhn"). Value, "")

StrDatePodp = Nz (Rec. Fields ("ДатаПодписи"). Value, Date)

StrDateProv = Nz (Rec. Fields ("ДатаПроверки"). Value, Date)

Else

MsgBox "Инв. опись ОС №" & nomer & " не найдена!", vbCritical + vbOKOnly

Exit Sub

End If

Set Rec = Nothing

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

Страница:  1  2  3  4  5  6  7  8  9  10  11  12  13  14  15 
 16  17  18  19  20  21  22  23  24  25  26  27  28  29  30 
 31  32  33  34  35  36  37  38  39  40  41  42 


Другие рефераты на тему «Программирование, компьютеры и кибернетика»:

Поиск рефератов

Последние рефераты раздела

Copyright © 2010-2024 - www.refsru.com - рефераты, курсовые и дипломные работы