Кто подскажет, что нужно еще поправить в модуле 2, чтобы он не выдавал ошибку при печати чека. Код скачал на форуме и пытаюсь встроить в свою базу.

Модератор: Тема перенесена из форума "Microsoft SQL Server".

Да, принтер чеков, драйвер у них с кассовым аппаратом один общий (ККТ), модуль демо с прилагаемым диском работает прекрасно, настройка свойств и т.д.. Но мне нужно выводить на печать данные с моих таблиц.

Прилагаю модуль демо.

Да этот пример напрямую не работает, чтобы он работал нужно установить драйвер и подключить принтер. Демо форму можно открыть в режиме конструктора и посмотреть код.

У меня чековый принтер АТОЛ FPrint55, у него в инструкции написано, что работает он под драйвером ККМ, единственное отличие у них то что ККМ фискализирована, а принтер нет. И Аксесс не может печатать напрямую на принтер, так как он его не видит как обычный принтер, а только через свой драйвер. Ошибка такая: Веденное выражение содержит функцию с неверным числом аргументов. А драйвер печатает молоко и прочую хрень из демо кода, а мне нужно чтобы он печатал именно мои данные из открытой формы Продажа товара.

Вот вот , именно это я и пытаюсь сделать, но пока не врубаюсь в тему, поэтому прошу помощи.

Не прошло и пол-года как я переделал всю базу по замечаниям, сделанным выше и теперь вроде аксесс на код не ругается, теперь проблема как сделать макрос, чтобы запустить функцию из модуля.

Создал макрос Запуск прокраммы с аргументом PrintRegChekSumm(curSum As Currency) As Boolean, но не работает выдает сообщение Приложению не удается найти имя "lngKod" из этого выражения.

Люди добрые подскажите кто что может. Изменил базу (прилагаю) но не могу согласовать с принтером, с принтером шел пример кода для применения с Аксесс, это Форма1 в базе, он гораздо короче и что самое главное запускается и работает, но только в демо варианте, а как из него сделать рабочую версию не соображу. Может кто что подскажет пока я изучаю курс по VBA.

Пардон, забыл кнопочку нажать.

Да отчет такой есть, Товарный чек называется, но принтер печатает долго, особенно после длительной паузы, тем более с 01.07.2018. обязательное применение ККМ, поэтому надо готовиться заранее, пока на ПД без фискальной памяти.

Вот эта форма с демо-вариантом, там настраивается связь с принтером в окне свойств, а при нажатии "Старт" печатаются демо-чеки.

Демо у меня работает, он внедрен в форму, а у меня код в модуле, а как его запустить не пойму. Пробовал внедрить в свою форму как советовали "внедренный макрос должен содержать вызов функции с доп.параметром PrintRegChekSumm(curSum As Currency), а он PrintRegChekSumm() функция Public Function PrintRegChekSumm(curSum As Currency) As Boolean" , но не получается.
Вот код из модуля:

Public Function PrintRegChek(lngKod As Long, Optional curSum As Currency) As Boolean
'Печать чека на регистраторе со сдачей.
Dim ECR As Object
Dim rst As New ADODB.Recordset
Dim rst1 As New ADODB.Recordset
Dim sql As String, sql1 As String, iDiscount As Integer
Dim intMark As Integer, curSumma As Currency, curSum1 As Currency, curSumDis As Currency

On Error GoTo Error_mark

12 sql = "SELECT tblПродажа.КодЧека, tblПродажа.Скидка,tblПродажа.Внесено,tblПродажаТовара.ШтрихКод, tblПродажаТовара.Количество, tblПродажаТовара.Цена "
sql = sql & "FROM ПродажаТовара INNER JOIN ТОВАР ON Продажа.КодЧека=ПродажаТовара.КодЧека"
sql = sql & "WHERE (((tblПродажа.КодЧека)=" & lngKod & "));"

22 If rst.State = adStateClosed Then
221 rst.Open sql, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
End If

222 iDiscount = rst![Скидка]

223 If rst.RecordCount = 0 Then GoTo Exit_mark

'Создаем объект общего драйвера ККМ
'Если объект создать не удается генерируется исключение, по которому завершается работа приложения
224 Set ECR = CreateObject("AddIn.FprnM45")

'Занимаем порт.
20 ECR.DeviceEnabled = True
294 If ECR.ResultCode <> 0 Then
225 If MsgBox("Ошибка ККМ: " + ECR.ResultDescription + "!", vbCritical + vbRetryCancel + vbDefaultButton1, conVersion) = vbRetry Then
GoTo 20
Else
226 If MsgBox("Чек не будет напечатан!", vbCritical + vbOKCancel + vbDefaultButton2, conVersion) = vbCancel Then
GoTo 20
Else
227 PrintRegChek = False
GoTo Exit_mark
End If
End If
End If

228 Select Case iDiscount 'Два варианта чека: без скидки и со скидкой.
Case 0 'Если без скидки.
'Метка для перехода при ошибке ввода суммы.
intMark = 1
'Входим в режим регистрации
'Устанавливаем пароль кассира
229 ECR.Password = "1"
'Входим в режим регистрации
230 ECR.Mode = 1
231 Select Case ECR.SetMode 'Входим в режим
Case -3822
If MsgBox("Чек не может быть напечатан! Текущая смена превысила 24 часа! Сделать гашение?", vbCritical + vbYesNo, conVersion) = vbYes Then
GoTo Gaschenie
Else
PrintRegChek = False
GoTo 3
End If
Case -3842
Call MsgBox("ККМ заблокирована после ввода некорректного пароля налогового инспектора!", vbCritical + vbOKOnly, conVersion)
PrintRegChek = False
GoTo 3
Case -3892
Call MsgBox("ККМ заблокирована после попытки ввода даты, меньшей чем дата последней записи в ФП!", vbCritical + vbOKOnly, conVersion)
PrintRegChek = False
GoTo 3
Case -3937
Call MsgBox("ККМ находится в режиме ввода даты или времени!", vbCritical + vbOKOnly, conVersion)
PrintRegChek = False
GoTo 3
Case Else
PrintRegChek = True
End Select

'Продажа co сдачeй
4 Do Until rst.EOF
41 ECR.Name = rst![ШтрихКод]
42 ECR.Price = rst![Цена]
43 ECR.Quantity = rst![Количество]
44 Select Case ECR.Registration
Case 0
Case -3807
11 Call MsgBox("Вставьте бумагу в ККМ и нажмите ОК.", vbExclamation + vbOKOnly, conVersion)
45 If ECR.CancelCheck <> 0 Then
PrintRegChek = False
GoTo 11
End If
46 rst.MoveFirst
GoTo 4
Case Else
PrintRegChek = False
GoTo Error_mark
End Select
47 rst.MoveNext
Loop

'Закрытие чека наличными с вводом полученной от клиента суммы
1 curSumma = CCur(InputBox("Внесено.", conVersion))

'Проверяем введеную сумму, полученную от покупателя.
48 If curSumma = 0 Then
'Повторяем ввод.
GoTo 1
End If

49 If curSumma < curSum Then
50 Call MsgBox("Введеная сумма меньше суммы чека - " & curSum & "!", vbCritical + vbOKOnly, conVersion)
'Повторяем ввод.
GoTo 1
End If

51 ECR.Summ = curSumma
52 ECR.TypeClose = 0
53 Select Case ECR.Delivery
Case -3807
10 Call MsgBox("Вставьте бумагу в ККМ и нажмите ОК.", vbExclamation + vbOKOnly, conVersion)
54 If ECR.CancelCheck <> 0 Then
PrintRegChek = False
GoTo 10
End If
55 rst.MoveFirst
GoTo 4
Case -3835
Call MsgBox("Введеная сумма меньше суммы чека - " & curSum & "!", vbCritical + vbOKOnly, conVersion)
'Повторяем ввод.
PrintRegChek = False
GoTo 1
Case 0
PrintRegChek = True
End Select

Case Is > 5
iDiscount = rst![Скидка]
If iDiscount > 15 Then
rst.Close
rst.Open sql, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
iDiscount = rst![Скидка]

If iDiscount > 5 Then
Call MsgBox("Скидка не правильна. Отбейте чек вручную.", vbCritical + vbOKOnly, conVersion)
PrintRegChek = False
GoTo Exit_mark
Else
GoTo 228
End If
Else
GoTo 228
End If
Case Else 'Со скидкой.
56 rst.Close

'Список со скидкой.
57 sql = "SELECT tblПродажа.КодЧека, tblПродажа.Скидка,tblПродажа.Внесено,tblПродажаТовара.ШтрихКод, tblПродажаТовара.Количество, tblПродажаТовара.Цена "
58 sql = sql & "FROM ПродажаТовара INNER JOIN ТОВАР ON Продажа.КодЧека=ПродажаТовара.КодЧека"
59 sql = sql & "WHERE (((tblПродажа.КодЧека)=" & lngKod & "));"
60 rst.Open sql, CurrentProject.Connection, adOpenKeyset, adLockOptimistic

'Список без скидки.
61 sql1 = "SELECT tblПродажа.КодЧека, tblПродажа.Скидка,tblПродажа.Внесено,tblПродажаТовара.ШтрихКод, tblПродажаТовара.Количество, tblПродажаТовара.Цена "
62 sql1 = sql & "FROM ПродажаТовара INNER JOIN ТОВАР ON Продажа.КодЧека=ПродажаТовара.КодЧека"
63 sql1 = sql1 & "WHERE (((tblПродажа.КодЧека)=" & lngKod & ") AND ((tblТовары.Скидка)=IsNull));"

64 rst1.Open sql1, CurrentProject.Connection, adOpenKeyset, adLockOptimistic

65 If rst.RecordCount = 0 Then
GoTo 21
Else
66 iDiscount = rst![Скидка]
End If

'Метка для перехода при ошибке ввода суммы.
intMark = 2

'Входим в режим регистрации
'Устанавливаем пароль кассира
67 ECR.Password = "1"
'Входим в режим регистрации
68 ECR.Mode = 1
69 Select Case ECR.SetMode 'Входим в режим
Case -3822
If MsgBox("Чек не может быть напечатан! Текущая смена превысила 24 часа! Сделать гашение?", vbCritical + vbYesNo, conVersion) = vbYes Then
70 rst.Close
71 rst1.Close
GoTo Gaschenie
Else
PrintRegChek = False
GoTo 3
End If
Case -3842
Call MsgBox("ККМ заблокирована после ввода некорректного пароля налогового инспектора!", vbCritical + vbOKOnly, conVersion)
72 rst1.Close
PrintRegChek = False
GoTo 3
Case -3892
Call MsgBox("ККМ заблокирована после попытки ввода даты, меньшей чем дата последней записи в ФП!", vbCritical + vbOKOnly, conVersion)
73 rst1.Close
PrintRegChek = False
GoTo 3
Case -3937
Call MsgBox("ККМ находится в режиме ввода даты или времени!", vbCritical + vbOKOnly, conVersion)
74 rst1.Close
PrintRegChek = False
GoTo 3
Case Else
PrintRegChek = True
End Select

'Продажа co сдачeй
'Закрытие чека наличными с вводом полученной от клиента суммы
2 curSumma = CSng(InputBox("Внесено.", conVersion))

'Проверяем введеную сумму, полученную от покупателя.
75 If curSumma = 0 Then
'Повторяем ввод.
GoTo 2
End If

76 If curSumma < curSum Then
Call MsgBox("Введеная сумма меньше суммы чека - " & curSum & "!", vbCritical + vbOKOnly, conVersion)
'Повторяем ввод.
GoTo 2
End If

7 Do Until rst.EOF
77 ECR.Name = rst![ШтрихКод]
78 ECR.Price = rst![Цена]
79 ECR.Quantity = rst![Количество]
80 curSum1 = curSum1 + rst![Цена] * rst![Количество]
81 Select Case ECR.Registration
Case 0
Case -3807
13 Call MsgBox("Вставьте бумагу в ККМ и нажмите ОК.", vbExclamation + vbOKOnly, conVersion)
82 If ECR.CancelCheck <> 0 Then
PrintRegChek = False
GoTo 13
End If
83 rst.MoveFirst
GoTo 7
Case Else
84 rst1.Close
PrintRegChek = False
GoTo Error_mark
End Select
85 rst.MoveNext
Loop

'Скидка
86 curSumDis = Round(curSum1 * iDiscount / 100)
87 ECR.Summ = curSumDis
88 ECR.Destination = 0
89 If ECR.SummDiscount <> 0 Then
PrintRegChek = False
GoTo Exit_mark
End If

90 If rst1.RecordCount = 0 Then
91 ECR.Summ = curSumma
92 ECR.TypeClose = 0
93 Select Case ECR.Delivery
Case -3807
14 Call MsgBox("Вставьте бумагу в ККМ и нажмите ОК.", vbExclamation + vbOKOnly, conVersion)
94 If ECR.CancelCheck <> 0 Then
PrintRegChek = False
GoTo 14
End If
95 rst.MoveFirst
GoTo 7
Case -3835
Call MsgBox("Введеная сумма меньше суммы чека - " & curSum & "!", vbCritical + vbOKOnly, conVersion)
'Повторяем ввод.
PrintRegChek = False
GoTo 2
Case 0
96 rst1.Close
PrintRegChek = True
GoTo 3
End Select
Else
'Закрытие чека
97 ECR.TypeClose = 0
98 Select Case ECR.CloseCheck
Case -3807
15 Call MsgBox("Вставьте бумагу в ККМ и нажмите ОК.", vbExclamation + vbOKOnly, conVersion)
99 If ECR.CancelCheck <> 0 Then
PrintRegChek = False
GoTo 15
End If
111 rst.MoveFirst
GoTo 7
Case 0
End Select
End If

'Входим в режим регистрации
'Устанавливаем пароль кассира
21 ECR.Password = "1"
'Входим в режим регистрации
112 ECR.Mode = 1
Select Case ECR.SetMode 'Входим в режим
Case -3822
If MsgBox("Чек не может быть напечатан! Текущая смена превысила 24 часа! Сделать гашение?", vbCritical + vbYesNo, conVersion) = vbYes Then
113 rst.Close
114 rst1.Close
GoTo Gaschenie
Else
PrintRegChek = False
GoTo 3
End If
Case -3842
Call MsgBox("ККМ заблокирована после ввода некорректного пароля налогового инспектора!", vbCritical + vbOKOnly, conVersion)
PrintRegChek = False
GoTo 3
Case -3892
Call MsgBox("ККМ заблокирована после попытки ввода даты, меньшей чем дата последней записи в ФП!", vbCritical + vbOKOnly, conVersion)
PrintRegChek = False
GoTo 3
Case -3937
Call MsgBox("ККМ находится в режиме ввода даты или времени!", vbCritical + vbOKOnly, conVersion)
PrintRegChek = False
GoTo 3
Case Else
PrintRegChek = True
End Select

'Продажа со сдачей
9 Do Until rst1.EOF
115 ECR.Name = rst1![ШтрихКод]
116 ECR.Price = rst1![Цена]
117 ECR.Quantity = rst1![Количество]
118 Select Case ECR.Registration
Case 0
Case -3807
16 Call MsgBox("Вставьте бумагу в ККМ и нажмите ОК.", vbExclamation + vbOKOnly, conVersion)
119 If ECR.CancelCheck <> 0 Then
PrintRegChek = False
GoTo 16
End If
120 rst1.MoveFirst
GoTo 9
Case Else
121 rst1.Close
PrintRegChek = False
GoTo Error_mark
End Select
122 rst1.MoveNext
Loop

'Закрытие чека
123 ECR.Summ = curSumma - (curSum1 - curSumDis)
124 ECR.TypeClose = 0
125 Select Case ECR.Delivery
Case -3807
17 Call MsgBox("Вставьте бумагу в ККМ и нажмите ОК.", vbExclamation + vbOKOnly, conVersion)
126 If ECR.CancelCheck <> 0 Then
PrintRegChek = False
GoTo 17
End If
127 rst1.MoveFirst
GoTo 9
Case -3835
Call MsgBox("Введеная сумма меньше суммы чека - " & curSum & "!", vbCritical + vbOKOnly, conVersion)
'Повторяем ввод.
PrintRegChek = False
GoTo 1
Case 0
PrintRegChek = True
End Select
rst1.Close
End Select

'Выходим в режим выбора, чтобы кто-то под введенными паролями не сделал что-нибудь нехорошее
3 If ECR.ResetMode <> 0 Then
PrintRegChek = False
GoTo Exit_mark
End If

'Освобождаем порт
128 ECR.DeviceEnabled = False
129 If ECR.ResultCode <> 0 Then
PrintRegChek = False
GoTo Exit_mark
End If

PrintRegChek = True

Exit_mark:
130 rst.Close
131 Set rst = Nothing
132 Set rst1 = Nothing
133 Set ECR = Nothing
Exit Function

Error_mark:
Select Case Err.Number
Case 0
If Erl = 224 Then
PrintRegChek = False
Exit Function
End If
Case 13
'Скорее всего неправильно введена сумма.
Select Case intMark
Case 1
GoTo 1
Case 2
GoTo 2
End Select
Case 91 'Выход из-за ошибки.
Call MsgBox("Ошибка создания объекта AddIn.FprnM45. Приложение завершит свою работу.", vbCritical + vbOKOnly, conVersion)
ReportError "PrintRegChek", Err.Number, Err.Source, Err.Description & " Ошибка в строке " & Erl
PrintRegChek = False
Exit Function
Case 3218 'Если таблица блокирована.
DoCmd.OpenForm "frmPause"
pause (10)
DoCmd.Close acForm, "frmPause"
GoTo 22
Case 3202 'Если таблица блокирована.
DoCmd.OpenForm "frmPause"
pause (10)
DoCmd.Close acForm, "frmPause"
GoTo 22
Case 3188 'Если таблица блокирована.
DoCmd.OpenForm "frmPause"
pause (10)
DoCmd.Close acForm, "frmPause"
GoTo 22
Case 3186 'Если таблица блокирована.
DoCmd.OpenForm "frmPause"
pause (10)
DoCmd.Close acForm, "frmPause"
GoTo 22
Case 3187 'Если таблица блокирована.
DoCmd.OpenForm "frmPause"
pause (10)
DoCmd.Close acForm, "frmPause"
GoTo 22
Case 3211 'Если таблица блокирована.
DoCmd.OpenForm "frmPause"
pause (10)
DoCmd.Close acForm, "frmPause"
GoTo 22
Case 3212 'Если таблица блокирована.
DoCmd.OpenForm "frmPause"
pause (10)
DoCmd.Close acForm, "frmPause"
GoTo 22
Case Else
Select Case Err.Description
Case "Чтение невозможно; блокировка другим пользователем." 'Если таблица блокирована.
DoCmd.OpenForm "frmPause"
pause (10)
DoCmd.Close acForm, "frmPause"
GoTo 22
Case Else
Call Protocol(Form_frmЛокальныеНастройки.ПолеКодПользователя, "Печать чека. " & lngKod, Err.Description)
ReportError "PrintRegChek", Err.Number, Err.Source, Err.Description & " Ошибка в строке " & Erl
PrintRegChek = False
Resume Next
End Select
End Select

Gaschenie:
'Выходим в режим выбора, чтобы кто-то под введенными паролями не сделал что-нибудь нехорошее
134 If ECR.ResetMode <> 0 Then
PrintRegChek = False
GoTo Exit_mark
End If

'Освобождаем порт
135 ECR.DeviceEnabled = False
136 If ECR.ResultCode <> 0 Then
PrintRegChek = False
GoTo Exit_mark
End If

137 Call PrintRegZReport

GoTo 20
End Function

Public Sub PrintRegXReport()
Dim ECR As Object
On Error GoTo Error_mark

If ProverkaRegistratoraQuick = False Then Exit Sub

'Создаем объект общего драйвера ККМ
'Если объект создать не удается генерируется исключение, по которому завершается работа приложения
Set ECR = CreateObject("AddIn.FprnM45")

'Занимаем порт
ECR.DeviceEnabled = True
Select Case ECR.ResultCode
Case 0
Case -3
Call MsgBox("Порт занят другим приложением или данный порт отсутсвует в ПК либо ККМ не включено.", vbCritical, conVersion)
GoTo Exit_mark
Case Else
GoTo Exit_mark
End Select

'X - отчет
'Устанавливаем пароль администратора ККМ
ECR.Password = "29"
'Входим в режим отчетов без гашения
ECR.Mode = 2
If ECR.SetMode <> 0 Then
GoTo 1
End If
'Снимаем отчет
ECR.ReportType = 2
3 Select Case ECR.Report
Case 0
Case -3807
Call MsgBox("Вставьте бумагу в ККМ и нажмите ОК.", vbExclamation + vbOKOnly, conVersion)
GoTo 3
Case Else
GoTo 1
End Select

'Выходим в режим выбора, чтобы кто-то под введенными паролями не сделал что нибуть нехорошее
1 If ECR.ResetMode <> 0 Then
End If

'Освобождаем порт
ECR.DeviceEnabled = False
If ECR.ResultCode <> 0 Then
GoTo Exit_mark
End If

Exit_mark:
Set ECR = Nothing
Exit Sub

Error_mark:
ReportError "PrintRegXReport", Err.Number, Err.Source, Err.Description & " Ошибка в строке " & Erl
Resume Next
End Sub

Public Sub PrintRegZReport()
Dim ECR As Object
On Error GoTo Error_mark

If ProverkaRegistratoraQuick = False Then Exit Sub

'Создаем объект общего драйвера ККМ
'Если объект создать не удается генерируется исключение, по которому завершается работа приложения
Set ECR = CreateObject("AddIn.FprnM45")

'Занимаем порт
ECR.DeviceEnabled = True
Select Case ECR.ResultCode
Case 0
Case -3
Call MsgBox("Порт занят другим приложением или данный порт отсутсвует в ПК либо ККМ не включено.", vbCritical, conVersion)
GoTo Exit_mark
Case Else
GoTo Exit_mark
End Select

'Z - отчет
'Устанавливаем пароль системного администратора ККМ
ECR.Password = "30"
'Входим в режим отчетов с гашением
ECR.Mode = 3
If ECR.SetMode <> 0 Then
Exit Sub
End If
'Снимаем отчет
ECR.ReportType = 1
3 Select Case ECR.Report
Case 0
Case -3807
Call MsgBox("Вставьте бумагу в ККМ и нажмите ОК.", vbExclamation + vbOKOnly, conVersion)
GoTo 3
Case -3828
Call MsgBox("Отчет с гашением уже снят.", vbExclamation + vbOKOnly, conVersion)
Case Else
End Select

'Выходим в режим выбора, чтобы кто-то под введенными паролями не сделал что нибуть нехорошее
1 If ECR.ResetMode <> 0 Then
End If

'Освобождаем порт
ECR.DeviceEnabled = False
If ECR.ResultCode <> 0 Then
GoTo Exit_mark
End If

Exit_mark:
Set ECR = Nothing
Exit Sub

Error_mark:
ReportError "PrintRegZReport", Err.Number, Err.Source, Err.Description & " Ошибка в строке " & Erl
Resume Next
End Sub

Public Function ProverkaRegistratora() As Boolean
'Проверка регистратора перед запуском программы.
On Error GoTo Error_mark

ProverkaRegistratora = True

'Создаем объект общего драйвера ККМ
5 Set ECR = CreateObject("AddIn.FprnM45")

'Занимаем порт.
6 ECR.DeviceEnabled = True
7 Select Case ECR.ResultCode
Case -3
Call MsgBox("Порт занят другим приложением или данный порт отсутсвует в ПК либо ККМ не включено.", vbCritical + vbOKOnly, conVersion)
ProverkaRegistratora = False
GoTo Exit_mark
Case 0
End Select

'Проверяем связь с ККМ.
8 Select Case ECR.GetCurrentMode
Case -1 'Нет связи с ККМ.
Call MsgBox("Нет связи с ККМ либо ККМ не включено!", vbCritical + vbOKOnly, conVersion)
ProverkaRegistratora = False
GoTo 2
End Select

9 If ECR.PrinterConnectionFailed = True Then 'Есть ли ошибки связи.
Call MsgBox("Ошибка связи с ККМ!", vbCritical + vbOKOnly, conVersion)
ProverkaRegistratora = False
GoTo 2
End If

10 If ECR.OutOfPaper = True Then 'Есть ли бумага.
Call MsgBox("В ККМ нет ленты!", vbCritical + vbOKOnly, conVersion)
ProverkaRegistratora = False
GoTo 1
End If

'Получаем состояние ККМ.
11 If ECR.GetStatus <> 0 Then
Call MsgBox("Ошибка ККМ: " + ECR.ResultDescription + "!", vbCritical + vbOKOnly, conVersion)
GoTo Error_mark
ProverkaRegistratora = False
GoTo 1
End If

12 If ECR.CheckPaperPresent = False Then 'Проверка ленты.
Call MsgBox("В ККМ нет ленты!", vbCritical + vbOKOnly, conVersion)
ProverkaRegistratora = False
GoTo 1
End If

13 If ECR.ControlPaperPresent = False Then 'Проверка ленты.
Call MsgBox("В ККМ нет контрольной ленты!", vbCritical + vbOKOnly, conVersion)
ProverkaRegistratora = False
GoTo 1
End If

14 If ECR.BatteryLow = True Then 'Проверка зарядки батареи.
Call MsgBox("Внимание разряжена батарея!", vbCritical + vbOKOnly, conVersion)
End If

4 Select Case ECR.CheckState 'Проверяем нет ли открытого чека.
Case 0 'Открытого чека нет.
Case Else 'Есть не закрытый чек.
15 Select Case ECR.CloseCheck 'Пытаемся закрыть чек.
Case 0 'Чек успешно закрыт.
Case -3807 'Нет бумаги.
Call MsgBox("Вставьте бумагу в ККМ и нажмите ОК.", vbExclamation + vbOKOnly, conVersion)
GoTo 4
Case Else 'Другая ошибка.
Call MsgBox("Ошибка закрытия чека!", vbCritical + vbOKOnly, conVersion)
ProverkaRegistratora = False
GoTo 1
End Select
End Select

'Если смена не открыта, открываем ее.
16 If ECR.SessionOpened = False Then
17 ECR.OpenSession
End If

'Выходим в режим выбора, чтобы кто-то под введенными паролями не сделал что нибуть нехорошее
1 If ECR.ResetMode <> 0 Then
End If

'Освобождаем порт
2 ECR.DeviceEnabled = False
18 If ECR.ResultCode <> 0 Then
GoTo Exit_mark
End If

Exit_mark:
19 Set ECR = Nothing
Exit Function

Error_mark:
ReportError "ProverkaRegistratora", Err.Number, Err.Source, Err.Description & " Ошибка в строке " & Erl
Resume Next
End Function

Public Function ProverkaRegistratoraQuick() As Boolean
'Быстрая проверка регистратора перед продажей.
On Error GoTo Error_mark

ProverkaRegistratoraQuick = True

'Создаем объект общего драйвера ККМ
5 Set ECR = CreateObject("AddIn.FprnM45")

'Занимаем порт.
6 ECR.DeviceEnabled = True
7 Select Case ECR.ResultCode
Case -3
Call MsgBox("Порт занят другим приложением или данный порт отсутсвует в ПК либо ККМ не включено.", vbCritical + vbOKOnly, conVersion)
ProverkaRegistratoraQuick = False
GoTo Exit_mark
Case 0
End Select

'Проверяем связь с ККМ.
8 Select Case ECR.GetCurrentMode
Case -1 'Нет связи с ККМ.
Call MsgBox("Нет связи с ККМ либо ККМ не включено!", vbCritical + vbOKOnly, conVersion)
ProverkaRegistratoraQuick = False
GoTo 2
End Select

9 If ECR.PrinterConnectionFailed = True Then 'Есть ли ошибки связи.
Call MsgBox("Ошибка связи с ККМ!", vbCritical + vbOKOnly, conVersion)
ProverkaRegistratoraQuick = False
GoTo 2
End If

10 If ECR.OutOfPaper = True Then 'Есть ли бумага.
Call MsgBox("В ККМ нет ленты!", vbCritical + vbOKOnly, conVersion)
ProverkaRegistratoraQuick = False
GoTo 1
End If

4 Select Case ECR.CheckState 'Проверяем нет ли открытого чека.
Case 0 'Открытого чека нет.
Case Else 'Есть не закрытый чек.
11 Select Case ECR.CloseCheck 'Пытаемся закрыть чек.
Case 0 'Чек успешно закрыт.
Case -3807 'Нет бумаги.
Call MsgBox("Вставьте бумагу в ККМ и нажмите ОК.", vbExclamation + vbOKOnly, conVersion)
GoTo 4
Case Else 'Другая ошибка.
Call MsgBox("Ошибка закрытия чека!", vbCritical + vbOKOnly, conVersion)
ProverkaRegistratoraQuick = False
GoTo 1
End Select
End Select

'Выходим в режим выбора, чтобы кто-то под введенными паролями не сделал что нибуть нехорошее
1 If ECR.ResetMode <> 0 Then
End If

'Освобождаем порт
2 ECR.DeviceEnabled = False
12 If ECR.ResultCode <> 0 Then
GoTo Exit_mark
End If

Exit_mark:
Set ECR = Nothing
Exit Function

Error_mark:
ReportError "ProverkaRegistratoraQuick", Err.Number, Err.Source, Err.Description & " Ошибка в строке " & Erl
Resume Next
End Function

Public Function ProverkaObjectFprnM45() As Boolean
'Проверяем можно ли создать объект драйвера ККМ.
'Тем самым грубо проверяем работает ли драйвер ККМ.
Dim ECR As Object
On Error GoTo Error_mark

'Создаем объект общего драйвера ККМ
'Если объект создать не удается генерируется исключение, по которому завершается работа приложения
Set ECR = CreateObject("AddIn.FprnM45")

ProverkaObjectFprnM45 = True
Set ECR = Nothing

Exit_mark:
Exit Function

Error_mark:
ProverkaObjectFprnM45 = False
ReportError "ProverkaObjectFprnM45", Err.Number, Err.Source, Err.Description
Resume Exit_mark
End Function

Public Function PrintRegChekSumm(curSum As Currency) As Boolean
'Печать чека на регистраторе со сдачей.
Dim ECR As Object
Dim intMark As Integer, curSumma As Currency, curSum1 As Currency, curSumDis As Currency

On Error GoTo Error_mark

'Создаем объект общего драйвера ККМ
'Если объект создать не удается генерируется исключение, по которому завершается работа приложения
224 Set ECR = CreateObject("AddIn.FprnM45")

'Занимаем порт.
20 ECR.DeviceEnabled = True
294 If ECR.ResultCode <> 0 Then
225 If MsgBox("Ошибка ККМ: " + ECR.ResultDescription + "!", vbCritical + vbRetryCancel + vbDefaultButton1, conVersion) = vbRetry Then
GoTo 20
Else
226 If MsgBox("Чек не будет напечатан!", vbCritical + vbOKCancel + vbDefaultButton2, conVersion) = vbCancel Then
GoTo 20
Else
227 PrintRegChekSumm = False
GoTo Exit_mark
End If
End If
End If

'Если без скидки.
'Метка для перехода при ошибке ввода суммы.
intMark = 1
'Входим в режим регистрации
'Устанавливаем пароль кассира
229 ECR.Password = "1"
'Входим в режим регистрации
230 ECR.Mode = 1
231 Select Case ECR.SetMode 'Входим в режим
Case -3822
If MsgBox("Чек не может быть напечатан! Текущая смена превысила 24 часа! Сделать гашение?", vbCritical + vbYesNo, conVersion) = vbYes Then
GoTo Gaschenie
Else
PrintRegChekSumm = False
GoTo 3
End If
Case -3842
Call MsgBox("ККМ заблокирована после ввода некорректного пароля налогового инспектора!", vbCritical + vbOKOnly, conVersion)
PrintRegChekSumm = False
GoTo 3
Case -3892
Call MsgBox("ККМ заблокирована после попытки ввода даты, меньшей чем дата последней записи в ФП!", vbCritical + vbOKOnly, conVersion)
PrintRegChekSumm = False
GoTo 3
Case -3937
Call MsgBox("ККМ находится в режиме ввода даты или времени!", vbCritical + vbOKOnly, conVersion)
PrintRegChekSumm = False
GoTo 3
Case Else
PrintRegChekSumm = True
End Select

'Продажа co сдачeй
42 ECR.Price = curSum
43 ECR.Quantity = 1
44 Select Case ECR.Registration
Case 0
Case -3807
11 Call MsgBox("Вставьте бумагу в ККМ и нажмите ОК.", vbExclamation + vbOKOnly, conVersion)
45 If ECR.CancelCheck <> 0 Then
PrintRegChekSumm = False
GoTo 11
End If
GoTo 42
Case Else
PrintRegChekSumm = False
GoTo Error_mark
End Select

'Закрытие чека наличными с вводом полученной от клиента суммы
1 curSumma = curSum

'Проверяем введеную сумму, полученную от покупателя.
48 If curSumma = 0 Then
'Повторяем ввод.
curSumma = CCur(InputBox("Внесено.", conVersion))
GoTo 48
End If

51 ECR.Summ = curSumma
52 ECR.TypeClose = 0
53 Select Case ECR.Delivery
Case -3807
10 Call MsgBox("Вставьте бумагу в ККМ и нажмите ОК.", vbExclamation + vbOKOnly, conVersion)
54 If ECR.CancelCheck <> 0 Then
PrintRegChekSumm = False
GoTo 10
End If
55 rst.MoveFirst
GoTo 51
Case -3835
Call MsgBox("Введеная сумма меньше суммы чека - " & curSum & "!", vbCritical + vbOKOnly, conVersion)
'Повторяем ввод.
PrintRegChekSumm = False
GoTo 1
Case 0
PrintRegChekSumm = True
End Select


'Выходим в режим выбора, чтобы кто-то под введенными паролями не сделал что-нибудь нехорошее
3 If ECR.ResetMode <> 0 Then
PrintRegChekSumm = False
GoTo Exit_mark
End If

'Освобождаем порт
128 ECR.DeviceEnabled = False
129 If ECR.ResultCode <> 0 Then
PrintRegChekSumm = False
GoTo Exit_mark
End If

PrintRegChekSumm = True

Exit_mark:
133 Set ECR = Nothing
Exit Function

Error_mark:
Select Case Err.Number
Case 0
If Erl = 224 Then
PrintRegChekSumm = False
Exit Function
End If
Case 91 'Выход из-за ошибки.
Call MsgBox("Ошибка создания объекта AddIn.FprnM45. Приложение завершит свою работу.", vbCritical + vbOKOnly, conVersion)
ReportError "PrintRegChekSumm", Err.Number, Err.Source, Err.Description & " Ошибка в строке " & Erl
PrintRegChekSumm = False
Exit Function
Case Else
Call Protocol(Form_frmЛокальныеНастройки.ПолеКодПользователя, "Печать чека. " & lngKod, Err.Description)
ReportError "PrintRegChekSumm", Err.Number, Err.Source, Err.Description & " Ошибка в строке " & Erl
PrintRegChekSumm = False
Resume Next
End Select

Gaschenie:
'Выходим в режим выбора, чтобы кто-то под введенными паролями не сделал что-нибудь нехорошее
134 If ECR.ResetMode <> 0 Then
PrintRegChekSumm = False
GoTo Exit_mark
End If

'Освобождаем порт
135 ECR.DeviceEnabled = False
136 If ECR.ResultCode <> 0 Then
PrintRegChekSumm = False
GoTo Exit_mark
End If

137 Call PrintRegZReport

GoTo 20
End Function

Он длинный , а вот демо попроще и может его можно переделать под мои потребности печати чеков.