MsgBox Err. Description, vbCritical + vbOKOnly
Код модуля OS2
Private Const NomerForm As Long = 2
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 cPodrazdName1 As Byte = 7
Private Const rPodrazdName1 As Integer = 9
Private Const cPodrazdOKPO1 As Byte = 88
Private Const rPodrazdOKPO1 As Integer = 8
Private Const cPodrazdName2 As Byte = 9
Private Const rPodrazdName2 As Integer = 11
Private Const cPodrazdOKPO2 As Byte = 88
Private Const rPodrazdOKPO2 As Integer = 10
Private Const cDateNakl As Byte = 69
Private Const rDateNakl As Integer = 16
Private Const cNomerNakl As Byte = 57
Private Const rNomerNakl As Integer = 16
Private Const cNomer As Byte = 1
Private Const cTovar As Byte = 5
Private Const cYear As Byte = 48
Private Const cInv As Byte = 58
Private Const cKol As Byte = 70
Private Const cCena As Byte = 80
Private Const cSum As Byte = 90
Private Const rSh1_1 As Integer = 24
Private Const rSh1_2 As Integer = 39
Private Const rSh2_1 As Integer = 8
Private Const rSh2_2 As Integer = 19
Private Const cSumItog As Byte = 90
Private Const rSumItog As Integer = 20
Private Const cSotrName1 As Byte = 42
Private Const rSotrName1 As Byte = 31
Private Const cSotrDolzh1 As Byte = 7
Private Const rSotrDolzh1 As Byte = 31
Private Const cSotrNomer1 As Byte = 64
Private Const rSotrNomer1 As Byte = 31
Private Const cDatDay1 As Byte = 79
Private Const rDatDay1 As Byte = 31
Private Const cDatMonth1 As Byte = 83
Private Const rDatMonth1 As Byte = 31
Private Const cDatYear1 As Byte = 96
Private Const rDatYear1 As Byte = 31
Private Const cSotrName2 As Byte = 42
Private Const rSotrName2 As Byte = 34
Private Const cSotrDolzh2 As Byte = 7
Private Const rSotrDolzh2 As Byte = 34
Private Const cSotrNomer2 As Byte = 64
Private Const rSotrNomer2 As Byte = 34
Private Const cDatDay2 As Byte = 79
Private Const rDatDay2 As Byte = 34
Private Const cDatMonth2 As Byte = 83
Private Const rDatMonth2 As Byte = 34
Private Const cDatYear2 As Byte = 96
Private Const rDatYear2 As Byte = 34
Private Const cGlBuch As Byte = 33
Private Const rGlBuch As Byte = 39
Private Const nSymbPrim As Byte = 60
Private Const nSymbPrim2 As Byte = 130
Private Const cPrim As Integer = 51
Private Const rPrim1 As Integer = 22
Private Const cPrim2 As Integer = 1
Private Const rPrim2_1 As Integer = 23
Private Const rPrim2_2 As Integer = 27
Sub PrintFormOS2 (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
Dim StrPodrazdName1 As String, StrPodrazdOKPO1 As String
Dim StrPodrazdName2 As String, StrPodrazdOKPO2 As String
Dim StrDate As Date, StrDate_s As Date, StrDate_p As Date
Dim StrSotrName1 As String, StrSotrNomer1 As String, StrSotrDolzh1 As String
Dim StrSotrName2 As String, StrSotrNomer2 As String, StrSotrDolzh2 As String
Dim StrItog As Double, s_Sum As Double
Dim StrMonth1 As String, StrMonth2 As String
Dim p As Integer, p2 As Integer, i As Long, NRecord 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
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, "")
MsgBox "Общие параметры фирмы не занесены!", vbCritical + vbOKOnly
Set Rec = db. OpenRecordset ("select * from запрос_ВнутренниеНакл where НомерНакл = " & nomer, dbOpenSnapshot)
StrPodrazdName1 = Nz (Rec. Fields ("p1"). Value, "")
StrPodrazdOKPO1 = Nz (Rec. Fields ("p1_okpo"). Value, "")
StrPodrazdName2 = Nz (Rec. Fields ("p2"). Value, "")
StrPodrazdOKPO2 = Nz (Rec. Fields ("p2_okpo"). Value, "")
StrDate = Nz (Rec. Fields ("ДатаНакл"). Value, Date)
StrDate_s = Nz (Rec. Fields ("ДатаНаклСдал"). Value, Date)
StrDate_p = Nz (Rec. Fields ("ДатаНаклПринял"). Value, Date)
StrNomer = Nz (Rec. Fields ("НомерНаклВнутр"). Value, nomer)
StrSotrName1 = Nz (Rec. Fields ("s1"). Value, "")
StrSotrNomer1 = Nz (Rec. Fields ("s1_nomer"). Value, "")
StrSotrDolzh1 = Nz (Rec. Fields ("s1_dolzh"). Value, "")
StrSotrName2 = Nz (Rec. Fields ("s2"). Value, "")
StrSotrNomer2 = Nz (Rec. Fields ("s2_nomer"). Value, "")
StrSotrDolzh2 = Nz (Rec. Fields ("s2_dolzh"). Value, "")
StrPrim = Nz (Rec. Fields ("Примечание"). Value, "")
MsgBox "Накладная №" & nomer & " не найдена!", vbCritical + vbOKOnly
Set Rec = db. OpenRecordset ("select * from ВспомДата where НомерМес = " & Month (StrDate_s), dbOpenSnapshot)
StrMonth1 = Nz (Rec. Fields ("НазвМес"). Value, "")
StrMonth1 = "нет названия"
Set Rec = db. OpenRecordset ("select * from ВспомДата where НомерМес = " & Month (StrDate_p), dbOpenSnapshot)
StrMonth2 = Nz (Rec. Fields ("НазвМес"). Value, "")
StrMonth2 = "нет названия"
Set oApp = CreateObject ("Excel. Application")
oApp. Workbooks. Open FileName: =StrPath, ReadOnly: =True
Application. SysCmd acSysCmdInitMeter, "Вывод информации о товарах", 100
oApp. ActiveWorkbook. Sheets (1). Select
Set RecList = db. OpenRecordset ("select * from запрос_ВнутренниеНаклТовары where НомерНакл = " & nomer, dbOpenSnapshot)
NRecord = RecList. RecordCount
NRecord = RecList. RecordCount
oApp. ActiveWorkbook. Sheets (1). Select
Application. SysCmd acSysCmdUpdateMeter, i / NRecord * 100
oApp. ActiveWorkbook. Sheets (2). Select
s_Sum = Nz (RecList. Fields ("Сумма"). Value, 0)
oApp. Cells (p, cNomer). Value = i
oApp. Cells (p, cTovar). 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, Year (Date))
oApp. Cells (p, cKol). Value = Nz (RecList. Fields ("Количество"). Value, 0)
oApp. Cells (p, cCena). Value = Format$ (Nz (RecList. Fields ("ЦенаРозн"). Value, 0), "0.00")
oApp. Cells (p, cSum). Value = Format$ (s_Sum, "0.00")
MsgBox "Для накладной №" & nomer & " нет перечня товаров!", vbCritical + vbOKOnly
oApp. Cells (rFirmName, cFirmName). Value = StrFirmName
oApp. Cells (rFirmOKPO, cFirmOKPO). Value = StrFirmOKPO
oApp. Cells (rPodrazdName1, cPodrazdName1). Value = StrPodrazdName1
oApp. Cells (rPodrazdOKPO1, cPodrazdOKPO1). Value = StrPodrazdOKPO1
oApp. Cells (rPodrazdName2, cPodrazdName2). Value = StrPodrazdName2
oApp. Cells (rPodrazdOKPO2, cPodrazdOKPO2). Value = StrPodrazdOKPO2
oApp. Cells (rNomerNakl, cNomerNakl). Value = StrNomer
oApp. Cells (rDateNakl, cDateNakl). Value = Format$ (StrDate, "dd. mm. yyyy")
oApp. ActiveWorkbook. Sheets (2). Select
oApp. Cells (rSumItog, cSumItog). Value = " " & Format$ (StrItog, "0.00")
oApp. Cells (rSotrDolzh1, cSotrDolzh1). Value = StrSotrDolzh1
oApp. Cells (rSotrName1, cSotrName1). Value = StrSotrName1
oApp. Cells (rSotrNomer1, cSotrNomer1). Value = StrSotrNomer1
oApp. Cells (rDatDay1, cDatDay1). Value = Format$ (StrDate_s, "dd")
oApp. Cells (rDatMonth1, cDatMonth1). Value = StrMonth1
oApp. Cells (rDatYear1, cDatYear1). Value = Right$ (Format$ (StrDate_s, "yyyy"),
1)
oApp. Cells (rSotrDolzh2, cSotrDolzh2). Value = StrSotrDolzh2