2. Должности_f

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)

SetLanguage Shift

End Sub

Private Sub Form_Load()

KOD_DEPART_AfterUpdate

End Sub

Private Sub Form_Resize()

With Me![Должности_SF]

If Me.InsideWidth < 7670 Then Me.InsideWidth = 7670

If Me.InsideWidth > .Left + .WIDTH Then .WIDTH = Me.InsideWidth - .Left

If Me.InsideHeight < .Top + 24 Then Me.InsideHeight = .Top + 24

If Me.InsideHeight > .Top + 24 Then .HEIGHT = Me.InsideHeight - .Top - 24

End With

End Sub

Public Sub KOD_DEPART_AfterUpdate()

ControlAfterUpdate Me

OperationsUpdate

Me![Должности_SF].Requery

End Sub

Private Sub OperationsUpdate()

Dim q() As String, i%

i = 1: ReDim Preserve q(1 To i)

q(i) = "DELETE Т_должности_подразделения.* FROM Т_должности_подразделения"

i = i + 1: ReDim Preserve q(1 To i)

q(i) = "INSERT INTO Т_должности_подразделения ( KOD_DEPART, KOD_POSITION )" & vbNewLine

q(i) = q(i) & "SELECT Должности_подразделения.KOD_DEPART, Должности_подразделения.KOD_POSITION" & vbNewLine

q(i) = q(i) & "FROM [Т_Должности_F] INNER JOIN " & vbNewLine

q(i) = q(i) & " Должности_подразделения ON [Т_Должности_F].KOD_DEPART = Должности_подразделения.KOD_DEPART"

i = i + 1: ReDim Preserve q(1 To i)

q(i) = "INSERT INTO Т_должности_подразделения ( KOD_DEPART, KOD_POSITION )" & vbNewLine

q(i) = q(i) & "SELECT Т_должности_подразделения.KOD_DEPART, Должности.ID" & vbNewLine

q(i) = q(i) & "FROM Должности LEFT JOIN Т_должности_подразделения ON Должности.ID = Т_должности_подразделения.KOD_POSITION" & vbNewLine

q(i) = q(i) & "WHERE Т_должности_подразделения.KOD_POSITION Is Null"

If Not ExecuteTrans("изменение", q) Then Exit Sub

End Sub

Private Sub USE_AfterUpdate()

ControlAfterUpdate Me

Me![Должности_SF].Requery

End Sub

3. Заказ_обедов_f

Private Sub BUT_ADD_ALL_Click()

Dim q() As String, i As Integer

If Not polzovatel(25, True) Then Exit Sub

If Nz(Me![CHECK], False) Then Exit Sub

If MsgBox("Будет добавлен список всех сотрудников, заказывающих обед", vbInformation + vbDefaultButton1 + vbOKCancel, Me.Caption) = vbCancel Then Exit Sub

i = 1: ReDim Preserve q(1 To i)

q(i) = "INSERT INTO Заказ_обедов ( KOD_FL, [DATE] )" & vbNewLine

q(i) = q(i) & "SELECT Сотрудники_на_обеды.KOD_FL, Т_заказ_обедов_F.DATE_NOW" & vbNewLine

q(i) = q(i) & "FROM Сотрудники_на_обеды, Т_заказ_обедов_F"

If Not ExecuteTrans("обновление", q) Then Exit Sub

Me![Заказ_обедов_SF].Requery

Me.Requery

End Sub

Private Sub BUT_CALC_Click()

If Not polzovatel(25, True) Then Exit Sub

Dim q() As String, i As Integer

i = 1: ReDim Preserve q(1 To i)

q(i) = "DELETE Заказ_обедов.OBED, Заказ_обедов.*" & vbNewLine

q(i) = q(i) & "FROM Заказ_обедов" & vbNewLine

q(i) = q(i) & "WHERE (((Заказ_обедов.OBED) Is Null))"

i = i + 1: ReDim Preserve q(1 To i) 'чистим уволенных сотрудников

q(i) = "DELETE DISTINCTROW Обеды_контроль.*" & vbNewLine

q(i) = q(i) & "FROM Обеды_контроль LEFT JOIN " & vbNewLine

q(i) = q(i) & " Заказ_обедов ON Обеды_контроль.DATE_OBED = Заказ_обедов.DATE" & vbNewLine

q(i) = q(i) & "WHERE (Заказ_обедов.ID Is Null) AND " & vbNewLine

q(i) = q(i) & " (Обеды_контроль.DATE_OBED<Date())"

i = i + 1: ReDim Preserve q(1 To i) 'чистим уволенных сотрудников

q(i) = "DELETE [Объект физическое лицо].UVOLEN, Сотрудники_на_обеды.*" & vbNewLine

q(i) = q(i) & "FROM Сотрудники_на_обеды INNER JOIN " & vbNewLine

q(i) = q(i) & " [Объект физическое лицо] ON Сотрудники_на_обеды.KOD_FL = [Объект физическое лицо].ID_FIZICHESK_FACE" & vbNewLine

q(i) = q(i) & "WHERE [Объект физическое лицо].UVOLEN=True"

If Not ExecuteTrans("обновление", q) Then Exit Sub

Me![Заказ_обедов_SF].Requery

Me.Requery

End Sub

Private Sub BUT_MINUS_Click()

Me![DATE_NOW] = DMax("DATE_OBED", "Обеды_контроль", "DATE_OBED<" & SQL_date(Me![DATE_NOW]))

DATE_NOW_BeforeUpdate (0)

DATE_NOW_AfterUpdate

End Sub

Private Sub BUT_PLUS_Click()

Me![DATE_NOW] = Nz(DMin("DATE_OBED", "Обеды_контроль", "DATE_OBED>" & SQL_date(Me![DATE_NOW])), Me![DATE_NOW] + 1)

DATE_NOW_BeforeUpdate (0)

DATE_NOW_AfterUpdate

End Sub

Private Sub BUT_PRINT_Click()

If Not polzovatel(25, True) Then Exit Sub

Dim q() As String, i As Integer

i = 0: ReDim q(0 To i)

q(i) = "DELETE Т_этикетки_для_обеда.* FROM Т_этикетки_для_обеда"

For i = 1 To 4

ReDim Preserve q(0 To i)

q(i) = "INSERT INTO Т_этикетки_для_обеда ( FIO, OBED, [DATE], NAIMEN )" & vbNewLine

q(i) = q(i) & "SELECT q_Фамилия_И_О.FIO, Choose(Заказ_обедов.OBED,""A"",""B"",""C"",""D"") & " & Quoted(" - " & i & ": " & Choose(i, "Салат", "Первое", "Второе", "Выпечка")) & ", format(Заказ_обедов.DATE,""ddd - dd mmmm""), [Объект блюда].[NAIMEN]" & IIf(i = 3, " & "" + ""+[Объект блюда_1].[NAIMEN]", "") & vbNewLine

q(i) = q(i) & "FROM (((Заказ_обедов INNER JOIN " & vbNewLine

q(i) = q(i) & " q_Фамилия_И_О ON Заказ_обедов.KOD_FL = q_Фамилия_И_О.ID) INNER JOIN " & vbNewLine

q(i) = q(i) & " Меню ON Заказ_обедов.DATE = Меню.DATE) LEFT JOIN " & vbNewLine

q(i) = q(i) & " [Объект блюда] ON Меню." & Choose(i, "SALAT", "PERVOE", "VTOROE", "VIPECHKA") & " = [Объект блюда].ID) " & vbNewLine

If i = 3 Then

q(i) = q(i) & " LEFT JOIN [Объект блюда] AS [Объект блюда_1] ON Меню.GARNIR = [Объект блюда_1].ID" & vbNewLine

End If

q(i) = q(i) & "WHERE (Заказ_обедов.DATE=" & SQL_date(Me![DATE_NOW]) & ") AND " & vbNewLine

q(i) = q(i) & " (Заказ_обедов.OBED<>0) AND " & vbNewLine

q(i) = q(i) & " (Заказ_обедов." & Choose(i, "SALAT", "PERVOE", "VTOROE", "VIPECHKA") & "=True)"

Next

If Not ExecuteTrans("этикетки на обеды", q) Then Exit Sub

If Me![SVOD] Then DoCmd.OpenReport "Обеды_свод_R", acViewPreview: Exit Sub

If Me![KOD_PRINTER] = 5 Then DoCmd.OpenReport "Обеды_R", acViewPreview: Exit Sub

If (Me![KOD_PRINTER] = 3) Or (Me![KOD_PRINTER] = 4) Or (Me![KOD_PRINTER] = 37) Or (Me![KOD_PRINTER] = 38) Then

PrintLabel "Этикетки_обед_маленький_R", acViewPreview, Me![KOD_PRINTER]

Else

PrintLabel "Этикетки_бейджик_45x75_R", acViewPreview, Me![KOD_PRINTER]

End If

End Sub

Private Sub CHECK_BeforeUpdate(Cancel As Integer)

Cancel = Not polzovatel(25, True)

End Sub

Private Sub DATE_NOW_AfterUpdate()

ControlAfterUpdate Me

Me.Requery

Me![Заказ_обедов_SF].Requery

Me![DATE_NOW].Requery

End Sub

Private Sub DATE_NOW_BeforeUpdate(Cancel As Integer)

If Not IsNull(DLookup("DATE_OBED", "Обеды_контроль", "DATE_OBED=" & SQL_date(Me![DATE_NOW]))) Then Exit Sub

Dim q() As String, i As Integer

i = 1: ReDim q(1 To i)

q(i) = "INSERT INTO Обеды_контроль ( DATE_OBED )" & vbNewLine

q(i) = q(i) & "SELECT " & SQL_date(Me![DATE_NOW])

If Not ExecuteTrans("этикетки на обеды", q) Then Exit Sub

End Sub

Private Sub DATE_NOW_DblClick(Cancel As Integer)

OpenCalendar Me

End Sub

Private Sub Form_Current()

Me![Заказ_обедов_SF].Enabled = Not Nz(Me![CHECK], False)

Me![CHECK].Caption = IIf(Nz(Me![CHECK], False), "Закрыто", "Открыто") & vbNewLine & Me![FL_CONTROL]

Me![CHECK].ForeColor = IIf(Nz(Me![CHECK], False), vbRed, vbBlack)

End Sub

Private Sub Form_Load()

DATE_NOW_BeforeUpdate (0)

End Sub

Private Sub Form_Resize()

StdResize Me![Заказ_обедов_SF], Me

End Sub

Private Sub CHECK_AfterUpdate()

Dim MSG As String

MSG = IIf(Me![CHECK], "Будет завершен заказ обедов на " & Me![DATE_NOW] & vbNewLine & "Все изменения будут запрещены", "Будет разрешен заказ обедов на " & Me![DATE_NOW])

If MsgBox(MSG, vbCritical + vbDefaultButton2 + vbOKCancel) <> vbOK Then FormUndo Me: Exit Sub

Me![KOD_FL] = DLookup("KOD_USER", gWORK_PLACE)

Me![DATESTAMP] = Now()

ControlAfterUpdate Me

Me.Requery

End Sub