"SELECT DateValue(Продажа.Дата) AS Выражение1, Продажа.КодКонтрагента, Sum(Продажа.Стоимость)*(-1) AS [Sum-Стоимость], Константы.КодЗаправки " & _
"FROM Продажа, Константы " & _
"WHERE (((Продажа.Дата)> all(select max(Начало) from Смены)))" & _
"GROUP BY DateValue(Продажа.Дата), Продажа.КодКонтрагента, Константы.КодЗаправки"
End Function
' Посылает на сервер все обороты
Public Function SendAllOboroti()
' Удаляем все обороты из локальной таблицы
DoCmd.RunSQL "Delete from Обороты"
' Записываем все обороты в локальную таблицу
DoCmd.RunSQL "INSERT INTO Обороты ( Дата, КодНоменклатуры, КодКонтрагента, Количество, Сумма, КодЗаправки )" & _
"SELECT DateValue(Продажа.Дата) AS Выражение1, Продажа.КодНоменклатуры, Продажа.КодКонтрагента, Sum(Продажа.Количество) AS [Sum-Количество], Sum(Продажа.Стоимость) AS [Sum-Стоимость], Константы.КодЗаправки " & _
"FROM Продажа , Константы " & _
"GROUP BY DateValue(Продажа.Дата), Продажа.КодНоменклатуры, Продажа.КодКонтрагента, Константы.КодЗаправки"
' Удаляем все обороты из таблицы сервера по этой заправке
DoCmd.RunSQL "Delete * from " & SDB() & "Обороты where КодЗаправки=" & KZ()
' Записываем все обороты в таблицу сервера
DoCmd.RunSQL "INSERT INTO " & SDB() & "Обороты ( Дата, КодНоменклатуры, КодКонтрагента, Количество, Сумма, КодЗаправки )" & _
' Универсальная функция: возращает результат работы запроса (первое поле, первая запись)
Public Function rz(strSQL As String)
Dim rstData As DAO.Recordset
Set db = CurrentDb
' открываем рекордсет
Set rstData = db.OpenRecordset(strSQL)
' определяем количество записей в рекордсете
rstData.MoveLast ' перемещение в конец рекордсета
rstData.MoveFirst ' перемещение в начало рекордсета
rz = rstData.Fields(0)
rstData.Close
'Получает справочники номенклатура и контрагенты
Public Function GetInfo()
' Удаляем всю номенклатуру
DoCmd.RunSQL "Delete from Номенклатура"
' Записываем номенклатуру
DoCmd.RunSQL "INSERT INTO Номенклатура Select * from " & SDB() & "Номенклатура"
' Удаляем всех Контрагентов
DoCmd.RunSQL "Delete from Контрагенты"
' Записываем Контрагентов
DoCmd.RunSQL "INSERT INTO Контрагенты Select * from " & SDB() & "Контрагенты"
'Проверяет необходимость заказа газа
Public Function Proverka()
Dim pr As Variant
' вычисляем продажи газа в среднем за посленюю неделю
pr = rz("SELECT Sum(Продажа.Количество)/7 AS [SumK] FROM Продажа WHERE (((Продажа.Дата)>=Date()-7)) and (((Продажа.КодНоменклатуры)=1))")
' если продаж нет, то присваиваем 0
If (IsNull(pr)) Then
pr = 0
End If
' вычисляем остатки газа
Ost = rz(" SELECT sum(s1) FROM (SELECT sum(Приход.Количество) as s1 FROM Приход WHERE (((Приход.КодНоменклатуры)=1)) union" & _
" SELECT sum(Количество)*-1 as s1 FROM Продажа WHERE (((КодНоменклатуры)=1)) ) AS [Alias1]")
' формируем строку сообщения
Str1 = "Продажи за день в среднем: " & Round(pr, 2) & vbCrLf & "Остаток на данный момент: " & Round(Ost, 2) & vbCrLf
' если остатки меньше средей продажи то выдаем предупреждение
If (pr > Ost) Then
MsgBox Str1 & "Внимание! Необходимо пополнить запасы"
Else
MsgBox Str1 & "У Вас достаточно запасов"
Форма авторизация
Нажатие кнопки вход
Private Sub Кнопка4_Click()
Dim db As Database
Dim strSQL As String
' Находим имя и пароль в таблице
x = DLookup("КодСотрудника", "Сотрудники", "(Фамилия=forms![Авторизация]!Поле1)and(Пароль=forms![Авторизация]!Поле2)")
If (x > 0) Then
Nempl = x
DoCmd.OpenForm "Продажа", , , ""
DoCmd.GoToRecord , , acNewRec
Forms!Продажа!КодСотрудника.DefaultValue = x
' Добавляем новую смену
DoCmd.RunSQL "insert into смены(КодСотрудника,Начало) values(" & x & ",'" & Now() & "')"
' задаем текст запроса
strSQL = "SELECT max(КодСмены) from Смены"
rstData.MoveLast
rstData.MoveFirst
y = rstData.Fields(0)
Forms!Продажа!КодСмены.DefaultValue = y
DoCmd.Close acForm, "Авторизация", acSaveYes
MsgBox ("Ошибка авторизации!Повторите ввод имени и пароля")
End Sub
Форма календарь
Option Compare Database
' переменная для ссылки на активное поле ввода
Private objActive As Control
Private Sub Form_Load()
' сохранить ссылку на активное поле
Set objActive = Screen.ActiveControl
Private Sub Form_Unload(Cancel As Integer)
' при выгрузке форму уничтожить ссылку
Set objActive = Nothing
Private Sub Кнопка1_Click()
If Not objActive Is Nothing Then
' передать значение указанному полю ввода
objActive = Calendar0
DoCmd.Close
Форма материальный отчет
Private Sub Кнопка7_Click()
On Error GoTo Err_Кнопка7_Click
Dim stDocName As String
stDocName = ChrW(1054) & ChrW(1090) & ChrW(1095) & ChrW(1077) & ChrW(1090) & ChrW(67) & ChrW(1056) & ChrW(1072) & ChrW(1079) & ChrW(1073) & ChrW(1080) & ChrW(1074) & ChrW(1082) & ChrW(1086) & ChrW(1081) & ChrW(1055) & ChrW(1086) & ChrW(1050) & ChrW(1083) & ChrW(1080) & ChrW(1077) & ChrW(1085) & ChrW(1090) & ChrW(1072) & ChrW(1084)
DoCmd.OpenReport stDocName, acPreview
Exit_Кнопка7_Click:
Exit Sub
Err_Кнопка7_Click:
MsgBox Err.Description
Resume Exit_Кнопка7_Click
Private Sub Кнопка12_Click()
On Error GoTo Err_Кнопка12_Click
stDocName = ChrW(1054) & ChrW(1090) & ChrW(1095) & ChrW(1077) & ChrW(1090) & ChrW(1055) & ChrW(1088) & ChrW(1086) & ChrW(1076) & ChrW(1072) & ChrW(1078) & ChrW(1072) & ChrW(1054) & ChrW(1087) & ChrW(1077) & ChrW(1088) & ChrW(1072) & ChrW(1090) & ChrW(1086) & ChrW(1088) & ChrW(1072) & ChrW(1084) & ChrW(1080)
Exit_Кнопка12_Click:
Err_Кнопка12_Click:
Resume Exit_Кнопка12_Click
Private Sub Кнопка10_Click()
' сделать активным поле, в которое нужно ввести дату
Поле1.SetFocus
' открыть форму ввода даты
DoCmd.OpenForm "Календарь"
Private Sub Кнопка13_Click()
On Error GoTo Err_Кнопка13_Click
stDocName = ChrW(1054) & ChrW(1090) & ChrW(1095) & ChrW(1077) & ChrW(1090) & ChrW(1052) & ChrW(1072) & ChrW(1090) & ChrW(1054) & ChrW(1090) & ChrW(1095) & ChrW(1077) & ChrW(1090)
Exit_Кнопка13_Click:
Err_Кнопка13_Click:
Resume Exit_Кнопка13_Click
Private Sub Кнопка14_Click()
Поле2.SetFocus
Форма продажа
' Закрытие смены и отправка информации на сервер
Private Sub Кнопка16_Click()
DoCmd.RunSQL "Update Смены set Окончание = '" & Now() & "' where КодСмены = (select max(КодСмены) from Смены)"
' Посылаем остатки на этот день
Module1.SendOstatki
' Записываем и посылаем обороты
Страницы: 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17
