Смекни!
smekni.com

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

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

Private Const cFirmReq As Byte = 1

Private Const rFirmReq As Integer = 13

Private Const cOsn As Byte = 18

Private Const rOsn As Integer = 25

Private Const cDatPriem As Byte = 88

Private Const rDatPriem As Integer = 28

Private Const cSchet As Byte = 88

Private Const rSchet As Integer = 30

Private Const cAmort As Byte = 88

Private Const rAmort As Integer = 32

Private Const cInv As Byte = 88

Private Const rInv As Integer = 33

Private Const cNomer As Byte = 36

Private Const rNomer As Integer = 32

Private Const cDat As Byte = 49

Private Const rDat As Integer = 32

Private Const cTovar As Byte = 15

Private Const rTovar As Integer = 36

Private Const cMest As Byte = 29

Private Const rMest As Integer = 39

Private Const cPerv As Byte = 65

Private Const rPerv As Integer = 13

Private Const cSrok As Byte = 73

Private Const rSrok As Integer = 13

Private Const cType As Byte = 81

Private Const rType As Integer = 13

Private Const cName2 As Byte = 1

Private Const rName2 As Integer = 24

Private Const cKol As Byte = 37

Private Const rKol As Integer = 24

Private Const cDatIspDay As Byte = 20

Private Const rDatIspDay As Integer = 3

Private Const cDatIspMon As Byte = 24

Private Const rDatIspMon As Integer = 3

Private Const cDatIspYear As Byte = 37

Private Const rDatIspYear As Integer = 3

Private Const cSootv1 As Byte = 31

Private Const rSootv1 As Integer = 5

Private Const cSootv2 As Byte = 31

Private Const rSootv2 As Integer = 6

Private Const cDorab1 As Byte = 57

Private Const rDorab1 As Integer = 5

Private Const cDorab2 As Byte = 57

Private Const rDorab2 As Integer = 6

Private Const cSootvInf As Byte = 1

Private Const rSootvInf As Integer = 7

Private Const cDorabInf As Byte = 51

Private Const rDorabInf As Integer = 7

Private Const cResult As Byte = 13

Private Const rResult As Integer = 11

Private Const cTDoc As Byte = 22

Private Const rTDoc As Integer = 13

Private Const cPredsDolzh As Byte = 15

Private Const rPredsDolzh As Integer = 14

Private Const cChl1Dolzh As Byte = 15

Private Const rChl1Dolzh As Integer = 16

Private Const cChl2Dolzh As Byte = 15

Private Const rChl2Dolzh As Integer = 18

Private Const cPredsName As Byte = 49

Private Const rPredsName As Integer = 14

Private Const cChl1Name As Byte = 49

Private Const rChl1Name As Integer = 16

Private Const cChl2Name As Byte = 49

Private Const rChl2Name As Integer = 18

Private Const cPrinDolzh As Byte = 56

Private Const rPrinDolzh As Integer = 24

Private Const cPrinName As Byte = 85

Private Const rPrinName As Integer = 24

Private Const cDatPrinDay As Byte = 52

Private Const rDatPrinDay As Integer = 27

Private Const cDatPrinMon As Byte = 56

Private Const rDatPrinMon As Integer = 27

Private Const cDatPrinYear As Byte = 69

Private Const rDatPrinYear As Integer = 27

Private Const cDatDovDay As Byte = 63

Private Const rDatDovDay As Integer = 28

Private Const cDatDovMon As Byte = 67

Private Const rDatDovMon As Integer = 28

Private Const cDatDovYear As Byte = 80

Private Const rDatDovYear As Integer = 28

Private Const cDatDovNomer As Byte = 85

Private Const rDatDovNomer As Integer = 28

Private Const cDatDovOsn As Byte = 57

Private Const rDatDovOsn As Integer = 29

Private Const cXranDolzh As Byte = 51

Private Const rXranDolzh As Integer = 32

Private Const cXranName As Byte = 80

Private Const rXranName As Integer = 32

Private Const cDatXranDay As Byte = 52

Private Const rDatXranDay As Integer = 35

Private Const cDatXranMon As Byte = 56

Private Const rDatXranMon As Integer = 35

Private Const cDatXranYear As Byte = 69

Private Const rDatXranYear As Integer = 35

Private Const cXranNomer As Byte = 85

Private Const rXranNomer As Integer = 34

Private Const cNomer2 As Byte = 80

Private Const rNomer2 As Integer = 39

Private Const cDatSost As Byte = 90

Private Const rDatSost As Integer = 39

Private Const cBuchName As Byte = 75

Private Const rBuchName As Integer = 41

Sub PrintFormOS1 (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 StrRukName As String, StrRukDolzh As String

Dim StrDatePodp As Date, StrDatePriem As Date, StrDate As Date, StrDateIsp As Date, StrPrinDate As Date, StrDovDate As Date, StrXranDate As Date

Dim StrOsn As String, StrSchet As String, StrAmort As String

Dim NomerVnutr As String, StrTovar As String

Dim StrInv As String

Dim StrStoim As Double, StrSroki As Long

Dim StrMethod As String, StrMest As String

Dim StrKol As Long

Dim vbSootv As Boolean, vbDorab As Boolean

Dim StrSootv As String, StrDorab As String

Dim StrZakl As String, StrTechDoc As String

Dim StrPredsName As String, StrPredsDolzh As String

Dim StrChl1Name As String, StrChl1Dolzh As String

Dim StrChl2Name As String, StrChl2Dolzh As String

Dim StrPrinName As String, StrPrinDolzh As String

Dim StrDovFor As String, StrDovNom As String

Dim StrXranName As String, StrXranDolzh As String, StrXranNomer As String

Dim StrMonthPodp As String, StrMonthIsp As String, StrMonthPrin As String, StrMonthDov As String, StrMonthXran 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