Смекни!
smekni.com

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

Private Const cMatName1 As Byte = 79

Private Const rMatName1 As Integer = 32

Private Const cMatName2 As Byte = 79

Private Const rMatName2 As Integer = 34

Private Const cMatName3 As Byte = 79

Private Const rMatName3 As Integer = 36

Private Const ciKol As Byte = 72

Private Const riKol As Integer = 28

Private Const ciStoim As Byte = 79

Private Const riStoim As Integer = 28

Private Const rSh1_1 As Integer = 10

Private Const rSh1_2 As Integer = 27

Private Const cNom As Byte = 1

Private Const cTovar As Byte = 6

Private Const cInv As Byte = 51

Private Const cDoc As Byte = 26

Private Const cDocDate As Byte = 32

Private Const cDocNomer As Byte = 38

Private Const cYear As Byte = 44

Private Const cZav As Byte = 58

Private Const cPasp As Byte = 65

Private Const cKol As Byte = 72

Private Const cSum As Byte = 79

Private Const ciKolNomProp As Byte = 27

Private Const riKolNomProp As Integer = 30

Private Const ciKolProp As Byte = 30

Private Const riKolProp As Integer = 32

Private Const ciSumProp As Byte = 20

Private Const riSumProp As Integer = 34

Private Const ciSumKopProp As Byte = 91

Private Const riSumKopProp As Integer = 36

Private Const ciKolNomProp2 As Byte = 27

Private Const riKolNomProp2 As Integer = 3

Private Const ciKolProp2 As Byte = 30

Private Const riKolProp2 As Integer = 5

Private Const ciSumProp2 As Byte = 20

Private Const riSumProp2 As Integer = 7

Private Const ciSumKopProp2 As Byte = 91

Private Const riSumKopProp2 As Integer = 9

Private Const cPredsDolzh As Byte = 19

Private Const rPredsDolzh As Integer = 13

Private Const cChl1Dolzh As Byte = 19

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

Private 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) <> "&bsol;" Then s_folder = s_folder + "&bsol;"

s_folder = s_folder + "blanks&bsol;"

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)

If Rec. RecordCount > 0 Then

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

Else

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

End If

Set Rec = Nothing

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

If Rec. RecordCount > 0 Then

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

Else

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

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 (rStruct, cStruct). Value = StrStruct

oApp. Cells (rOsn, cOsn). Value = StrOsn

oApp. Cells (rOsnDate, cOsnDate). Value = StrDateOsn

oApp. Cells (rOsnNomer, cOsnNomer). Value = StrNomerOsn

oApp. Cells (rDate1, cDate1). Value = Format$ (StrDate1, "dd. mm. yyyy")

oApp. Cells (rDate2, cDate2). Value = Format$ (StrDate2, "dd. mm. yyyy")

oApp. Cells (rMest, cMest). Value = StrMest

oApp. Cells (rMatDolzhn1, cMatDolzhn1). Value = StrMatDolzhn1

oApp. Cells (rMatDolzhn2, cMatDolzhn2). Value = StrMatDolzhn2

oApp. Cells (rMatDolzhn3, cMatDolzhn3). Value = StrMatDolzhn3

oApp. Cells (rMatName1, cMatName1). Value = StrMatName1

oApp. Cells (rMatName2, cMatName2). Value = StrMatName2

oApp. Cells (rMatName3, cMatName3). Value = StrMatName3

oApp. ActiveWorkbook. Sheets (2). Select

Application. SysCmd acSysCmdInitMeter, "Вывод информации о товарах", 100

StrItog = 0

StrItogKol = 0

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