4. Календарь_f

Option Compare Database

Option Explicit

Dim cls As rControlForm

Dim DateFormChange As Form

Dim DateControlGhange As Control

Private Sub Form_Open(Cancel As Integer)

Set cls = New rControlForm

cls.GetForm Me

End Sub

Private Sub Calendar0_DblClick()

DateControlGhange.value = Me.Calendar0

CloseObject acForm, Me.NAME

'ControlAfterUpdate DateControlGhange.Parent 'если выполняются события после обновления, то не нужно

Set DateControlGhange = Nothing

Set DateFormChange = Nothing

End Sub

Public Property Let LastDate(DD As Control)

'получаем ссылки на основную форму, с которой вызывается календарь

With Application.Screen

Set DateControlGhange = .ActiveControl 'получаем ссылку на поле

Set DateFormChange = .ActiveForm 'получаем ссылку на основную форму

End With

Me.Calendar0.value = Nz(DD, DATE)

If Not DateFormChange Is Nothing Then

FormPlacement DateControlGhange 'раньше использовалось определение положения без API qwerty

End If

End Property

Private Sub FormPlacement(ByRef ctl As Control)

Dim ctlRect As gRect

Dim frmDimensions As Dimensions

Dim frmRect As gRect

ctlRect = ControlRect(ctl)

frmDimensions = FormDimensions(Me)

frmRect.Left = ctlRect.Left '+ 40

frmRect.Top = ctlRect.Top + TwipToPixel(ctl.HEIGHT)

SetWindowPos Me.hwnd, 0, frmRect.Left, frmRect.Top, frmDimensions.Width, frmDimensions.HEIGHT, SWP_NOZORDER

Me.VISIBLE = True

End Sub

Private Function ColW(i As Integer) As Integer 'функция определения ширины колонок по номеру столбца

Dim K As Control

For Each K In Forms(DateFormChange.NAME)(DateControlGhange.Parent.NAME).Form.Controls

If K.ControlType = acTextBox Or K.ControlType = acComboBox Then

'если номер колонки меньше нашей и она не скрытая

If Forms(DateFormChange.NAME)(DateControlGhange.Parent.NAME).Form.Controls(K.NAME).ColumnOrder < i And Not Forms(DateFormChange.NAME)(DateControlGhange.Parent.NAME).Form.Controls(K.NAME).ColumnHidden Then

ColW = ColW + Forms(DateFormChange.NAME)(DateControlGhange.Parent.NAME).Form.Controls(K.NAME).ColumnWidth

End If

End If

Next

End Function

Private Function IsSection(i As Integer) As Boolean

IsSection = True

On Error GoTo Errhandler

If DateFormChange.Section(i).HEIGHT > 0 Then Exit Function

Errhandler:

IsSection = False

End Function

Private Sub Form_Timer()

On Error Resume Next

If (Not Application.Screen.ActiveForm Is Me) Or (Err.Number > 0) Then DoCmd.Close acForm, Me.NAME

End Sub

5. Меню_F

Private Sub BUT_PRINT_Click()

OpenReport "Меню_R", acViewPreview, , , , , False

End Sub

Private Sub DATE_BEG_Enter()

OpenCalendar Me

Me![Меню_SF].Requery

End Sub

Private Sub Form_Open(Cancel As Integer)

Cancel = Not polzovatel(24, False)

If Cancel Then OpenReport "Меню_R", acViewPreview, , , , , False

End Sub

Private Sub Form_Resize()

StdResize Me![Меню_SF], Me

End Sub

6. Назначение_должности_f

Private Sub BUT_ADD_Click()

Dim Worked As Boolean

Dim i As Integer, q() As String

If Nz(Me![POS]) = 0 Then

MsgBox "Вы не выбрали должность": Exit Sub

End If

If Nz(Me![FIO]) = 0 Then

MsgBox "Вы не выбрали фамилию сотрудника": Exit Sub

End If

If Nz(Me![KOD_DEPART]) = 0 Then

MsgBox "Вы не выбрали подразделение": Exit Sub

End If

Worked = False

If (Nz(DLookup("TIME_BEG", "Учет_времени", "KOD_FL = " & Nz(Me![FIO], 0))) <> 0) And (Nz(DLookup("TIME_END", "Учет_времени", "KOD_FL = " & Nz(Me![FIO], 0))) = 0) Then

MsgBox Me![ListView5].SelectedItem.ListSubItems(1) & " находится на работе": Worked = True

If Nz(DLookup("KOD_POSITION", "Учет_времени", "KOD_FL = " & Nz(Me![FIO], 0))) = 2 Then Exit Sub

End If

If DLookup("id_position", "Назначеные_должности", "KOD_FL=" & Me![FIO]) Then

Select Case MsgBox("Сотрудник " & Me![FIO].Column(1) & " имеет должность " & DLookup("position", "Должности", "ID=" & DLookup("id_position", "Назначеные_должности", "KOD_FL=" & Me![FIO])) & vbNewLine & _

"Назначить новую должность: " & Me![POS].Column(1) & "?", vbOKCancel + vbDefaultButton2 + vbQuestion)

Case vbOK:

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

q(i) = "UPDATE Назначеные_должности " & vbNewLine

q(i) = q(i) & "SET Назначеные_должности.ID_POSITION = " & Me![POS] & ", " & vbNewLine

q(i) = q(i) & "Назначеные_должности.DATE_E = Null, Назначеные_должности.KOD_DEPART =" & Me![KOD_DEPART].Column(0) & ", " & vbNewLine

q(i) = q(i) & "Назначеные_должности.KOD_PLACE =" & Me![KOD_DEPART].Column(1) & vbNewLine

q(i) = q(i) & "WHERE Назначеные_должности.KOD_FL = " & Me![FIO]

If Not ExecuteTrans("назначение должности", q) Then Exit Sub

If Worked And (Me![POS] = 2) Then

OpenForm "Предназначение_разнорабочего_F", , , , , acDialog, Me![FIO]

End If

Me![POS] = 0

Me![FIO] = 0

ListGen

Exit Sub

Case vbCancel: Exit Sub

End Select

End If

Select Case MsgBox("Принять " & Me![FIO].Column(1) & " на должность " & Me![POS].Column(1) & "?", vbQuestion + vbOKCancel + vbDefaultButton2)

Case vbCancel: Exit Sub

End Select

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

q(i) = "INSERT INTO Назначеные_должности (ID_POSITION, KOD_FL, DATE_N, KOD_PLACE, KOD_DEPART)" & vbNewLine

q(i) = q(i) & "SELECT " & Me![POS] & ", " & Me![FIO] & ", " & vbNewLine

q(i) = q(i) & "Date(), " & Me![KOD_DEPART].Column(1) & ", " & Me![KOD_DEPART].Column(0)

If Not ExecuteTrans("назначение должности", q) Then Exit Sub

Me![POS] = 0

Me![FIO] = 0

ListGen

End Sub

Private Sub BUT_DEL_Click()

If IsNull(Me![ListView5].SelectedItem) Then

MsgBox "Выберите сотрудника для увольнения": Exit Sub

Else

If (Nz(DLookup("TIME_BEG", "Учет_времени", "KOD_FL = " & Me![ListView5].SelectedItem)) <> 0) And (Nz(DLookup("TIME_END", "Учет_времени", "KOD_FL = " & Me![ListView5].SelectedItem)) = 0) Then

MsgBox Me![ListView5].SelectedItem.ListSubItems(1) & " находится на работе" & vbNewLine & _

"Чтобы уволить сотрудника, отпустите его с работы": Exit Sub

Else

Select Case MsgBox("Вы точно хотите уволить сотрудника?", vbQuestion + vbOKCancel + vbDefaultButton2)

Case vbOK:

Dim i As Integer, q() As String

i = 1: ReDim q(1 To i)

q(i) = "UPDATE Назначеные_должности " & vbNewLine

q(i) = q(i) & "SET Назначеные_должности.DATE_E = Date()" & vbNewLine

q(i) = q(i) & "WHERE Назначеные_должности.KOD_FL = " & Me![ListView5].SelectedItem

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

q(i) = " DELETE Учет_времени.KOD_FL" & vbNewLine

q(i) = q(i) & "FROM Учет_времени" & vbNewLine

q(i) = q(i) & "WHERE Учет_времени.KOD_FL=" & Me![ListView5].SelectedItem

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

MsgBox "Уволен " & Me![ListView5].SelectedItem.ListSubItems(2) & ": " & Me![ListView5].SelectedItem.ListSubItems(1)

ListGen

Case vbCancel: Exit Sub

End Select

End If

End If

End Sub

Private Sub FIO_AfterUpdate()

Me![FIO].Requery

End Sub

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

If ShCodeRead(KeyCode) = gSH_CODE_POLZ Then Me![FIO] = gSTR_SH_CODE

End Sub

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

SetLanguage Shift

End Sub

Private Sub Form_Load()

Dim KP%

Dim rs As Recordset

Dim db As Database

Dim SQLsting As String

With Me![TreeView3]

.Style = tvwTreelinesPlusMinusText

.LineStyle = tvwRootLines

.Indentation = 240

.Appearance = ccFlat

.HideSelection = False

.BorderStyle = ccFixedSingle

.HotTracking = True

.FullRowSelect = False

.Checkboxes = False

.SingleSel = False

.Sorted = False

.Scroll = True

.LabelEdit = tvwManual

.Font.NAME = "Tahoma"

.Font.Size = 10

KP = DLookup("KOD_PLACE", gWORK_PLACE)

Set db = CurrentDb()

SQLsting = "SELECT [Объект подразделение].ID, " & vbNewLine

SQLsting = SQLsting & "[Объект подразделение].NAIMEN " & vbNewLine

SQLsting = SQLsting & "FROM [Объект подразделение]" & vbNewLine

SQLsting = SQLsting & "WHERE [Объект подразделение].KOD_PLACE=" & KP

Set rs = db.OpenRecordset(SQLsting)

rs.MoveFirst

While Not rs.EOF

.Nodes.Add , , "n" & rs![ID], rs![NAIMEN]

rs.MoveNext

Wend

rs.Close

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

SQLsting = SQLsting & "Должности.ID, " & vbNewLine

SQLsting = SQLsting & "Должности.POSITION" & vbNewLine

SQLsting = SQLsting & "FROM ([Объект подразделение] INNER JOIN " & vbNewLine

SQLsting = SQLsting & "Должности_подразделения ON [Объект подразделение].ID = Должности_подразделения.KOD_DEPART) INNER JOIN " & vbNewLine

SQLsting = SQLsting & "Должности ON Должности_подразделения.KOD_POSITION = Должности.ID" & vbNewLine

SQLsting = SQLsting & "WHERE [Объект подразделение].KOD_PLACE=" & KP

Set rs = db.OpenRecordset(SQLsting)

rs.MoveFirst

While Not rs.EOF

.Nodes.Add "n" & rs![KOD_DEPART], 4, "n" & rs![KOD_DEPART] & "m" & rs![ID], rs![POSITION]

rs.MoveNext

Wend

rs.Close

End With ' Me![TreeView3].Nodes("n" & IDP & "m" & ID).ForeColor = rgb(1.2 * DLookup("TARIFF", "Должности", "ID=" & ID), 0, 255 - DLookup("TARIFF", "Должности", "ID=" & ID))

With Me![ListView5]

.Font.NAME = "Tahoma"

.Font.Size = 9

End With

End Sub

Private Sub ListView5_Click()

Me![FIO] = Me![ListView5].SelectedItem

End Sub

Private Sub ListView5_ColumnClick(ByVal ColumnHeader As Object)

Me![ListView5].SortKey = ColumnHeader.index - 1

Me![ListView5].Sorted = True

Me![ListView5].SortOrder = 1 Xor Me![ListView5].SortOrder

End Sub

Private Sub ListView5_DblClick()

Dim i As Integer, q() As String

OpenForm "Печать_бейджей_F"

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

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

q(i) = q(i) & "SELECT " & Me![ListView5].SelectedItem

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

Forms!Печать_бейджей_F.Requery

End Sub

Private Sub ListView5_KeyDown(KeyCode As Integer, ByVal Shift As Integer)

If KeyCode = vbKeySpace Then

Dim i As Integer, q() As String

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

If Me![ListView5].SelectedItem.ListSubItems(7) = "постоян." Then

q(i) = "DELETE Постоянные_сотрудники.* FROM Постоянные_сотрудники" & vbNewLine

q(i) = q(i) & "WHERE KOD_FL=" & Me![ListView5].SelectedItem

If Not ExecuteTrans("временный сотрудник", q) Then Exit Sub

Me![ListView5].SelectedItem.ListSubItems(7).Text = "времен."

Else

q(i) = "INSERT INTO Постоянные_сотрудники (KOD_FL)" & vbNewLine

q(i) = q(i) & "SELECT " & Me![ListView5].SelectedItem

If Not ExecuteTrans("постоянный сотрудник", q) Then Exit Sub

Me![ListView5].SelectedItem.ListSubItems(7).Text = "постоян."

End If

End If

End Sub

Private Sub TreeView3_NodeClick(ByVal Node As Object)

Me![POS] = CheckPOSITION(Node.key)

Me![KOD_DEPART] = CheckDEPART(Node.key)

KOD_DEPART_AfterUpdate

End Sub

Private Function CheckPOSITION(key As String) As Integer

CheckPOSITION = 0

key = Mid(key, InStr(key, "m") + 1)

If key <> "" Then CheckPOSITION = Val(key)

End Function

Private Function CheckDEPART(key As String) As Integer

CheckDEPART = 0

If InStr(key, "m") <> 0 Then

key = Mid(key, InStr(key, "n") + 1, InStr(key, "m") - InStr(key, "n"))

Else

key = Mid(key, InStr(key, "n") + 1)

End If

If key <> "" Then CheckDEPART = Val(key)

End Function

Private Sub Form_Open(Cancel As Integer)

Dim lv As ListView

ListGen

Me![FIO] = Me.OpenArgs

End Sub

Private Sub Form_Resize()

StdResize Me![ListView5], Me

With Me![ListView5]

Me![TreeView3].HEIGHT = .HEIGHT

End With

End Sub

Private Sub KOD_DEPART_AfterUpdate()

If IsNull(Me![KOD_DEPART]) Then Me![KOD_DEPART] = 0

POS_AfterUpdate

End Sub

Private Sub ListGen()

Dim SQL As String

SQL = "SELECT Назначеные_должности.ID, " & vbNewLine

SQL = SQL & "Назначеные_должности.KOD_FL AS [Таб №], " & vbNewLine

SQL = SQL & "q_Фамилия_И_О.FIO AS [Фамилия имя отчество], " & vbNewLine

SQL = SQL & "Должности.POSITION AS Должность," & vbNewLine

SQL = SQL & "Должности.TARIFF AS Тариф, Format([DATE_N],""yyyy/mm/dd"") AS Назначен, " & vbNewLine

SQL = SQL & "Format([DATE_E],""yyyy/mm/dd"") AS Уволен, [Объект подразделение].NAIMEN AS Подразделение, " & vbNewLine

SQL = SQL & "IIf(Not IsNull(Постоянные_сотрудники.KOD_FL),""постоян."",""времен."") AS Устройство " & vbNewLine

SQL = SQL & "FROM (((Назначеные_должности INNER JOIN " & vbNewLine

SQL = SQL & "Должности ON Назначеные_должности.ID_POSITION=Должности.ID) INNER JOIN " & vbNewLine

SQL = SQL & "q_Фамилия_И_О ON Назначеные_должности.KOD_FL=q_Фамилия_И_О.ID) LEFT JOIN " & vbNewLine

SQL = SQL & "[Объект подразделение] ON Назначеные_должности.KOD_DEPART=[Объект подразделение].ID) LEFT JOIN " & vbNewLine

SQL = SQL & "Постоянные_сотрудники ON Назначеные_должности.KOD_FL=Постоянные_сотрудники.KOD_FL " & vbNewLine

SQL = SQL & "WHERE (((Назначеные_должности.DATE_E) Is Null) And " & vbNewLine

SQL = SQL & " ((" & Me![KOD_DEPART] & ")=0 Or (" & Me![KOD_DEPART] & ")=Назначеные_должности.KOD_DEPART) And " & vbNewLine

SQL = SQL & " ((" & Me![POS] & ")=0 Or (" & Me![POS] & ")=Должности.ID)) Or " & vbNewLine

SQL = SQL & " (((" & Me![KOD_DEPART] & ")=0 Or (" & Me![KOD_DEPART] & ")=Назначеные_должности.KOD_DEPART) And " & vbNewLine

SQL = SQL & " ((" & Me![POS] & ")=0 Or (" & Me![POS] & ")=Должности.ID) And " & vbNewLine

SQL = SQL & " ((" & Me![UVOLEN] & ")=True)) ORDER BY Назначеные_должности.DATE_N DESC"

Me![Sum_all] = Init_ListView(Me![ListView5], SQL)

End Sub

Private Sub POS_AfterUpdate()

If IsNull(Me![POS]) Then Me![POS] = 0

Me![POS].Requery

ListGen

End Sub

Private Sub POS_Enter()

Me![POS].Requery

End Sub

Private Sub UVOLEN_Click()

ListGen

End Sub

Private Sub Кнопка11_Click()

OpenForm "Должности_F", , , , , acDialog

End Sub

Private Sub Кнопка12_Click()

OpenForm "Добавление_сотрудников_F", , , , , acDialog

End Sub