Private Const cDatePriem As Byte = 53
Private Const rDatePriem As Integer = 16
Private Const cDateSpis As Byte = 53
Private Const rDateSpis As Integer = 17
Private Const cPost As Byte = 17
Private Const rPost As Integer = 21
Private Const cPerv As Byte = 53
Private Const rPerv As Integer = 35
Private Const cSrok As Byte = 59
Private Const rSrok As Integer = 35
Private Const cOsn As Byte = 1
Private Const rOsn As Integer = 59
Private Const cOper As Byte = 10
Private Const rOper As Integer = 59
Private Const cStruct As Byte = 19
Private Const rStruct As Integer = 59
Private Const cOstStoim As Byte = 39
Private Const rOstStoim As Integer = 59
Private Const cOtvSotr As Byte = 49
Private Const rOtvSotr As Integer = 59
Private Const cTovar2 As Byte = 1
Private Const rTovar2 As Integer = 19
Private Const cKol As Byte = 32
Private Const rKol As Integer = 19
Private Const cInvDolzh As Byte = 33
Private Const rInvDolzh As Integer = 36
Private Const cInvName As Byte = 67
Private Const rInvName As Integer = 36
Sub PrintFormOS6 (ByVal nomer As Long)
Dim db As Database, Rec As DAO. Recordset, RecList As DAO. Recordset
Dim StrFile As String, s_folder As String, StrPath As String
Dim StrFirmName As String, StrFirmOKPO As String, StrFirmAddr As String, StrFirmReq As String
Dim StrSchet As String, StrAmot As String
Dim NomerVnutr As String, StrDate As Date
Dim StrTovar As String, StrInv As String
Dim StrStoim As Double, StrOstStoim As Double, StrSroki As Long
Dim StrMest As String, StrKol As Long
Dim StrDatePriem As Date, StrDateSpis As Date
Dim StrPost As String, StrOsn As String, StrOper As String, StrStruct As String
Dim StrOtvSotr As String, StrInvSotr As String, StrInvSotrDolzhn As String
s_folder = CurrentProject. Path
1) <> "\" Then s_folder = s_folder + "\"
s_folder = s_folder + "blanks\"
If Len (Dir$ (s_folder, vbDirectory)) = 0 Then
MsgBox "Путь к папке с бланками " & s_folder & " не обнаружен!", vbCritical + vbOKOnly
Set Rec = db. OpenRecordset ("select * from Формы where НомерФорма = " & NomerForm, dbOpenSnapshot)
StrFormName = Rec. Fields ("Наименование"). Value
StrFile = Rec. Fields ("Файл"). Value
MsgBox "Нет информации о форме №" & NomerForm & "!", vbCritical + vbOKOnly
If Len (Dir$ (StrPath)) = 0 Then
MsgBox "Файл бланка формы '" & StrFormName & "' " & StrPath & " не обнаружен!", vbCritical + vbOKOnly
Set Rec = db. OpenRecordset ("SELECT Параметры. *, Сотрудники. Сотрудник FROM Сотрудники INNER JOIN Параметры ON Сотрудники. НомерСотр = Параметры. ГлБухгалтер", dbOpenSnapshot)
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, "")
MsgBox "Общие параметры фирмы не занесены!", vbCritical + vbOKOnly
Set Rec = db. OpenRecordset ("select * from запрос_ИнвКарты where НомерИнвентКарты = " & nomer, dbOpenSnapshot)
StrSchet = Nz (Rec. Fields ("Счет"). Value, "")
StrAmot = Nz (Rec. Fields ("НомерАмортГруппы"). Value, "")
NomerVnutr = Nz (Rec. Fields ("НомерВнутр"). Value, nomer)
StrDate = Nz (Rec. Fields ("ДатаИнвКарты"). Value, Date)
StrTovar = Nz (Rec. Fields ("Товар"). Value, "")
StrInv = Nz (Rec. Fields ("ИнвКод"). Value, "")
StrStoim = Nz (Rec. Fields ("ПервСтоииость"). Value, 0)
StrSroki = Nz (Rec. Fields ("СрокИспользования"). Value, 0)
StrMest = Nz (Rec. Fields ("Местонахождение"). Value, "")
StrKol = Nz (Rec. Fields ("Количество"). Value,
1)
StrDatePriem = Nz (Rec. Fields ("ДатаПринятия"). Value, Date)
StrDateSpis = Nz (Rec. Fields ("ДатаСписания"). Value, Date)
StrPost = Nz (Rec. Fields ("НаименованиеПост"). Value, "")
StrOsn = Nz (Rec. Fields ("ОснованиеПриема"). Value, "")
StrOper = Nz (Rec. Fields ("ВидОперации"). Value, "")
StrStruct = Nz (Rec. Fields ("СтруктурноеПодразделение"). Value, "")
StrOstStoim = Nz (Rec. Fields ("ОстСтоииость"). Value, 0)
StrOtvSotr = Nz (Rec. Fields ("ОтвСотр"). Value, "")
StrInvSotr = Nz (Rec. Fields ("ИнвСотр"). Value, "")
StrInvSotrDolzhn = Nz (Rec. Fields ("Должность"). Value, "")
MsgBox "Инвентарная карточка №" & nomer & " не найдена!", vbCritical + vbOKOnly
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 (rTovar, cTovar). Value = StrTovar
oApp. Cells (rMest, cMest). Value = StrMest
oApp. Cells (rSchet, cSchet). Value = StrSchet
oApp. Cells (rAmort, cAmort). Value = StrAmot
oApp. Cells (rInv, cInv). Value = StrInv
oApp. Cells (rDatePriem, cDatePriem). Value = Format$ (StrDatePriem, "dd. mm. yyyy")
oApp. Cells (rDateSpis, cDateSpis). Value = Format$ (StrDateSpis, "dd. mm. yyyy")
oApp. Cells (rPost, cPost). Value = StrPost
oApp. Cells (rPerv, cPerv). Value = Format$ (StrStoim, "0.00")
oApp. Cells (rSrok, cSrok). Value = StrSroki & " мес."
oApp. Cells (rOsn, cOsn). Value = StrOsn
oApp. Cells (rOper, cOper). Value = StrOper
oApp. Cells (rStruct, cStruct). Value = StrStruct
oApp. Cells (rOstStoim, cOstStoim). Value = Format$ (StrOstStoim, "0.00")
oApp. Cells (rOtvSotr, cOtvSotr). Value = StrOtvSotr
oApp. ActiveWorkbook. Sheets (2). Select
oApp. Cells (rTovar2, cTovar2). Value = StrTovar
oApp. Cells (rKol, cKol). Value = StrKol & " шт."
oApp. Cells (rInvDolzh, cInvDolzh). Value = StrInvSotrDolzhn
oApp. Cells (rInvName, cInvName). Value = StrInvSotr
Application. SysCmd acSysCmdRemoveMeter
If Not (oApp Is Nothing) Then oApp. Visible = True
MsgBox Err. Description, vbCritical + vbOKOnly
Код модуля OS6b
Private Const NomerForm As Long = 7
Private Const cFirmName As Byte = 1
Private Const rFirmName As Integer = 7
Private Const cFirmOKPO As Byte = 88
Private Const rFirmOKPO As Integer = 7
Private Const cStruct As Byte = 1
Private Const rStruct As Integer = 9
Private Const cDat1Day As Byte = 30
Private Const rDat1Day As Integer = 23
Private Const cDat1Mon As Byte = 34
Private Const rDat1Mon As Integer = 23
Private Const cDat1Year As Byte = 49
Private Const rDat1Year As Integer = 23
Private Const cDat2Day As Byte = 57
Private Const rDat2Day As Integer = 23
Private Const cDat2Mon As Byte = 61
Private Const rDat2Mon As Integer = 23
Private Const cDat2Year As Byte = 76
Private Const rDat2Year As Integer = 23
Private Const cInvName As Byte = 48
Private Const rInvName As Integer = 33
Private Const cInvDolzhn As Byte = 24
Private Const rInvDolzhn As Integer = 33
Private Const cInvNomer As Byte = 88
Private Const rInvNomer As Integer = 33
Private Const rSh1_1 As Integer = 8
Private Const rSh1_2 As Integer = 35
Private Const cNomer As Byte = 1
Private Const cTovar As Byte = 5
Private Const cInv As Byte = 20
Private Const cOsn As Byte = 30
Private Const cDatePrin As Byte = 43
Private Const cStructTov As Byte = 52
Private Const cOtv As Byte = 61
Private Const cPervStoim As Byte = 70
Private Const cSrok As Byte = 80
Private Const cAmort As Byte = 90
Private Const cOstStoim As Byte = 1
Sub PrintFormOS6b (ByVal v_dat1 As Date, _
ByVal nomer_struct As Long, ByVal StrStruct As String)
Dim db As Database, qry As DAO. QueryDef, Rec As DAO. Recordset, RecList As DAO. Recordset
Dim StrFile As String, s_folder As String, StrPath As String
Dim StrFirmName As String, StrFirmOKPO As String
Dim StrInvOtvName As String, StrInvOtvDolzhn As String, StrInvOtvNomer As String
Dim StrMonth1 As String, StrMonth2 As String
Dim i As Long, NRecord As Long, p As Long
s_folder = CurrentProject. Path
1) <> "\" Then s_folder = s_folder + "\"
s_folder = s_folder + "blanks\"
If Len (Dir$ (s_folder, vbDirectory)) = 0 Then
MsgBox "Путь к папке с бланками " & s_folder & " не обнаружен!", vbCritical + vbOKOnly
Set Rec = db. OpenRecordset ("select * from Формы where НомерФорма = " & NomerForm, dbOpenSnapshot)
StrFormName = Rec. Fields ("Наименование"). Value
StrFile = Rec. Fields ("Файл"). Value
MsgBox "Нет информации о форме №" & NomerForm & "!", vbCritical + vbOKOnly