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

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

p = rSh1_1 - 1

While Not RecList. EOF

i = i + 1

p = p + 1

Application. SysCmd acSysCmdUpdateMeter, i / NRecord * 100

If p > rSh1_2 Then GoTo lbl_ex

s_Sum = Nz (RecList. Fields ("Сумма"). Value, 0)

s_Kol = Nz (RecList. Fields ("Количество"). Value, 0)

oApp. Cells (p, cNom). Value = i

oApp. Cells (p, cTovar). Value = Nz (RecList. Fields ("Товар"). Value, "")

oApp. Cells (p, cDoc). Value = Nz (RecList. Fields ("ОснованиеПринятия"). Value, "")

oApp. Cells (p, cDocDate). Value = Format$ (Nz (RecList. Fields ("ДокДатаПринятия"). Value, Date), "dd. mm. yyyy")

oApp. Cells (p, cDocNomer). Value = Nz (RecList. Fields ("ДокНомерПринятия"). Value, "")

oApp. Cells (p, cYear). Value = Nz (RecList. Fields ("ГодВыпуска"). Value, Year (Date))

oApp. Cells (p, cInv). Value = Nz (RecList. Fields ("ИнвКод"). Value, "")

oApp. Cells (p, cPasp). Value = Nz (RecList. Fields ("НомерПоПаспорту"). Value, "")

oApp. Cells (p, cZav). Value = Nz (RecList. Fields ("НомерЗавод"). Value, "")

oApp. Cells (p, cKol). Value = s_Kol

oApp. Cells (p, cSum). Value = Format$ (s_Sum, "0.00")

StrItogKol = StrItogKol + s_Kol

StrItog = StrItog + s_Sum

RecList. MoveNext

Wend

Else

MsgBox "Для описи №" & nomer & " нет перечня товаров!", vbCritical + vbOKOnly

Exit Sub

End If

lbl_ex:

Set RecList = Nothing

oApp. Cells (riKol, ciKol). Value = StrItogKol

oApp. Cells (riStoim, ciStoim). Value = StrItog

oApp. Cells (riKolNomProp, ciKolNomProp). Value = translateNumber (i)

oApp. Cells (riKolProp, ciKolProp). Value = translateNumber (StrItogKol)

oApp. Cells (riSumProp, ciSumProp). Value = translateNumber (Int (StrItog))

oApp. Cells (riSumKopProp, ciSumKopProp). Value = Format$ (Int ( (StrItog - Int (StrItog)) * 100 + 0.5), "00")

oApp. ActiveWorkbook. Sheets (3). Select

oApp. Cells (riKolNomProp2, ciKolNomProp2). Value = translateNumber (i)

oApp. Cells (riKolProp2, ciKolProp2). Value = translateNumber (StrItogKol)

oApp. Cells (riSumProp2, ciSumProp2). Value = translateNumber (Int (StrItog))

oApp. Cells (riSumKopProp2, ciSumKopProp2). Value = Format$ (Int ( (StrItog - Int (StrItog)) * 100 + 0.5), "00")

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 (rChl3Name, cChl3Name). Value = StrChl3Name

oApp. Cells (rChl3Dolzh, cChl3Dolzh). Value = StrChl3Dolzh

oApp. Cells (r2MatDolzhn1, c2MatDolzhn1). Value = StrMatDolzhn1

oApp. Cells (r2MatDolzhn2, c2MatDolzhn2). Value = StrMatDolzhn2

oApp. Cells (r2MatDolzhn3, c2MatDolzhn3). Value = StrMatDolzhn3

oApp. Cells (r2MatName1, c2MatName1). Value = StrMatName1

oApp. Cells (r2MatName2, c2MatName2). Value = StrMatName2

oApp. Cells (r2MatName3, c2MatName3). Value = StrMatName3

oApp. Cells (rDatPodpDay, cDatPodpDay). Value = Format$ (StrDatePodp, "dd")

oApp. Cells (rDatPodpMon, cDatPodpMon). Value = StrMonthPodp

oApp. Cells (rDatPodpYear, cDatPodpYear). Value = Format$ (StrDatePodp, "yyyy")

oApp. Cells (rDatProvDay, cDatProvDay). Value = Format$ (StrDateProv, "dd")

oApp. Cells (rDatProvMon, cDatProvMon). Value = StrMonthProv

oApp. Cells (rDatProvYear, cDatProvYear). Value = Format$ (StrDateProv, "yyyy")

ex:

Application. SysCmd acSysCmdRemoveMeter

If Not (oApp Is Nothing) Then oApp. Visible = True

Set RecList = Nothing

Set oApp = Nothing

Set db = Nothing

Exit Sub

LblErr:

MsgBox Err. Description, vbCritical + vbOKOnly

GoTo ex

End Sub

Код модуля OS1

Option Compare Database

Option Explicit

Private Const NomerForm As Long = 3

Private Const cRukDolzh As Byte = 56

Private Const rRukDolzh As Integer = 4

Private Const cRukName As Byte = 85

Private Const rRukName As Integer = 4

Private Const cDatRukDay As Byte = 62

Private Const rDatRukDay As Integer = 6

Private Const cDatRukMon As Byte = 66

Private Const rDatRukMon As Integer = 6

Private Const cDatRukYear As Byte = 79

Private Const rDatRukYear As Integer = 6

Private Const cFirmName As Byte = 16

Private Const rFirmName As Integer = 9

Private Const cFirmOKPO As Byte = 88

Private Const rFirmOKPO As Integer = 9

Private Const cFirmAddr As Byte = 1

Private Const rFirmAddr As Integer = 11

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