Добавил:
Upload Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:
ДР_М (2).docx
Скачиваний:
4
Добавлен:
01.07.2025
Размер:
9 Мб
Скачать
☆
    1. Печать_бейджей_f

Private Sub BUT_CLEAR_Click()

Dim q() As String, i As Integer

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

q(i) = "DELETE Т_Печать_бейджей_F.*" & vbNewLine

q(i) = q(i) & "FROM Т_Печать_бейджей_F"

If Not ExecuteTrans("очистка бейждей", q) Then Exit Sub

Me.Requery

End Sub

Private Sub BUT_PRINT_Click()

If Me![KOD_PRINTER] = 5 Then DoCmd.OpenReport "Бейджик_R", acViewPreview: Exit Sub

If (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 Form_Close()

Dim q() As String, i As Integer

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

q(i) = "DELETE Т_Печать_бейджей_F.*" & vbNewLine

q(i) = q(i) & "FROM Т_Печать_бейджей_F"

If Not ExecuteTrans("очистка бейджей", q) Then Exit Sub

End Sub

Private Sub Form_Current()

Form_Resize

End Sub

Private Sub Form_Load()

Me.RecordSource = MyRecordSource(Me.NAME)

End Sub

Private Sub Form_Resize()

Me.InsideHeight = Me.Section(acHeader).HEIGHT + Me.Section(acFooter).HEIGHT + DCount("KOD_FL", "Т_Печать_бейджей_F") * 240 + 25

End Sub

    1. Права_доступа_f

Private Sub BUT_DEL_Click()

If Not DLookup("MODE", "Пользователи_права", "KOD_FL=" & DLookup("KOD_USER", gWORK_PLACE) & " AND KOD_MENU=7") Then Exit Sub

Dim q() As String, i As Integer

Select Case MsgBox("Вы точно хотите удалить доступ для пользователя " & DLookup("FIO", "q_Фамилия_И_О", "ID=" & Me![SPISOK]), vbOKCancel + vbQuestion + vbDefaultButton2)

Case vbOK:

Case vbCancel: Exit Sub

End Select

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

q(i) = "DELETE Доступ_к_программе.* FROM Доступ_к_программе" & vbNewLine

q(i) = q(i) & "WHERE KOD_FL=" & Me![SPISOK]

If Not ExecuteTrans("удаление пароля", q) Then Exit Sub

Me![SPISOK].Requery

End Sub

Private Sub BUT_LEVEL_UP_Click()

If Not polzovatel(17, True) Then Exit Sub

Dim q() As String, i As Integer

If Me![PERS].ListIndex < 0 Then MsgBox "Выберите сотрудника", , Me.Caption: Me![PERS].SetFocus: Exit Sub

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

q(i) = "INSERT INTO Доступ_к_программе ( KOD_FL )" & vbNewLine

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

q(i) = q(i) & "FROM [Объект физическое лицо]" & vbNewLine

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

If Not ExecuteTrans("доступ", q) Then Exit Sub

Me![PERS].Requery

Me![SPISOK].Requery

End Sub

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

SetLanguage Shift

End Sub

Private Sub Form_Resize()

With Me![ADMINKA]

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

End With

With Me![SPISOK_PRAV]

If Me.InsideHeight < .Top + Me.Section(acFooter).HEIGHT Then Me.InsideHeight = .Top + Me.Section(acFooter).HEIGHT

If Me.InsideHeight > .Top + Me.Section(acFooter).HEIGHT Then .HEIGHT = Me.InsideHeight - .Top - Me.Section(acFooter).HEIGHT

End With

With Me![SPISOK]

If Me.InsideHeight < .Top + Me.Section(acFooter).HEIGHT Then Me.InsideHeight = .Top + Me.Section(acFooter).HEIGHT

If Me.InsideHeight > .Top + Me.Section(acFooter).HEIGHT Then .HEIGHT = Me.InsideHeight - .Top - Me.Section(acFooter).HEIGHT

End With

With Me![OBJECT_MENU]

If Me.InsideHeight < .Top + Me.Section(acFooter).HEIGHT Then Me.InsideHeight = .Top + Me.Section(acFooter).HEIGHT

If Me.InsideHeight > .Top + Me.Section(acFooter).HEIGHT Then .HEIGHT = Me.InsideHeight - .Top - Me.Section(acFooter).HEIGHT

End With

End Sub

Private Sub OBJECT_MENU_DblClick(Cancel As Integer)

If IsNull(Me![OBJECT_MENU]) Then Exit Sub

Dim q() As String, i As Integer

If DLookup("KOD_USER", gWORK_PLACE) = DLookup("KOD_FL", "[Т_Права_доступа_F]") Then Exit Sub

If DLookup("MODE", "Пользователи_права", "KOD_FL=" & DLookup("KOD_USER", gWORK_PLACE) & " AND KOD_PLACE=" & DLookup("KOD_PLACE", gWORK_PLACE) & " AND KOD_MENU=" & Me![OBJECT_MENU]) Then

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

If IsNull(DLookup("KOD_FL", "Пользователи_права", "KOD_MENU=" & Me![OBJECT_MENU] & " AND KOD_FL=" & Me![SPISOK] & " AND KOD_PLACE=" & DLookup("KOD_PLACE", gWORK_PLACE))) Then

q(i) = "INSERT INTO Пользователи_права ( KOD_PLACE, KOD_FL, KOD_MENU, MODE, KOD_FL_ADM )" & vbNewLine

q(i) = q(i) & "SELECT " & DLookup("KOD_PLACE", gWORK_PLACE) & ", " & Me![SPISOK] & ", " & Me![OBJECT_MENU] & ", False, " & DLookup("KOD_USER", gWORK_PLACE)

Else

q(i) = "DELETE Пользователи_права.* FROM Пользователи_права" & vbNewLine

q(i) = q(i) & "WHERE KOD_FL=" & Me![SPISOK] & " AND KOD_MENU=" & Me![OBJECT_MENU] & " AND KOD_PLACE=" & DLookup("KOD_PLACE", gWORK_PLACE)

End If

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

Me![SPISOK_PRAV].Requery

Me![OBJECT_MENU].Requery

End If

End Sub

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

If KeyCode = vbKeySpace Then MsgBox UserAllowedList(Me![OBJECT_MENU]), vbInformation, Me![OBJECT_MENU].Column(0)

End Sub

Private Sub SPISOK_AfterUpdate()

If Not ControlAfterUpdate(Me) Then Exit Sub

Me![SPISOK_PRAV].Requery

Me![OBJECT_MENU].Requery

End Sub

Private Sub SPISOK_PRAV_DblClick(Cancel As Integer)

If DLookup("KOD_USER", gWORK_PLACE) = DLookup("KOD_FL", "[Т_Права_доступа_F]") Then Exit Sub

If DLookup("MODE", "Пользователи_права", "KOD_FL=" & DLookup("KOD_USER", gWORK_PLACE) & " AND KOD_MENU=" & Me![SPISOK_PRAV]) Then

Dim q() As String, i As Integer

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

q(i) = "UPDATE Пользователи_права " & vbNewLine

q(i) = q(i) & "SET MODE= not MODE," & vbNewLine

q(i) = q(i) & " KOD_FL_ADM=" & DLookup("KOD_USER", gWORK_PLACE) & vbNewLine

q(i) = q(i) & "WHERE KOD_FL=" & Me![SPISOK] & " AND" & vbNewLine

q(i) = q(i) & " KOD_MENU=" & Me![SPISOK_PRAV] & " AND" & vbNewLine

q(i) = q(i) & " KOD_PLACE=" & DLookup("KOD_PLACE", gWORK_PLACE)

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

Me![SPISOK_PRAV].Requery

End If

End Sub