Создание табеля учета рабочего времени

Connectiondbpath = App.Path & "\tabel.mdb"constr = "Provider= Microsoft.Jet.OLEDB.4.0;Data Source=" & dbpathconn.OpenconstrDim records As ADODB.RecordsetSet records = New ADODB.Recordsetrecords.ActiveConnection = connsqlstr = "select Дата, Выходной From Выходные where Выходной = True"records.Opensqlstrdat = CDate(d & "." & Combo1.Text & "." & Combo2.Text)Do While (Not records.EOF)If dat = records.Fields(0).Value ThenVyh = True Exit Do ElseVyh = FalseEnd Ifrecords.MoveNextLooprecords.Closeconn.CloseEnd FunctionFunction DaysInMonth(dCurdate As Date) As IntegerDaysInMonth = DateDiff("d", DateSerial(Year(dCurdate), Month(dCurdate), 1), _DateSerial(Year(dCurdate), Month(dCurdate) + 1, 1))End FunctionPrivate Sub Form_Unload(Cancel As Integer)If MsgBox("Сохранитьоткрытийтабель?", vbOKCancel) = vbOK ThencmdSave_Click Form1.HideEnd IfForm1.HideEnd SubPrivate Sub MSFlexGrid1_KeyPress(KeyAscii As Integer)If MSFlexGrid1.Col > 2 Then If KeyAscii = 13 Then MSFlexGrid1.Row = MSFlexGrid1.Row + 1 Exit Sub End If MSFlexGrid1.Text = MSFlexGrid1.Text & Chr(KeyAscii) Text1 = MSFlexGrid1.TextEnd IfEnd SubPrivate Sub Text1_Change()MSFlexGrid1.Text = Text1End SubForm2.frmPrivate Sub Command1_Click()DlgDol.ShowDlgDol.bIsRed = False 'добавлениеновогоEnd SubPrivate Sub Command2_Click()DlgOtdel.ShowDlgOtdel.bIsRed = True 'редактированиеc = grd1.RowDlgOtdel.Text1.Text = grd1.TextMatrix(c, 1)DlgOtdel.iKodOtdela = grd1.TextMatrix(c, 0)End SubPrivate Sub Form_Load()GrdLoadEnd SubPublic Sub GrdLoad()Dim conn As ADODB.ConnectionDim constr, sqlstr, dbpath As StringSet conn = New ADODB.Connectiondbpath = App.Path & "\tabel.mdb"constr = "Provider= Microsoft.Jet.OLEDB.4.0;Data Source=" & dbpathconn.OpenconstrDim records As ADODB.RecordsetSet records = New ADODB.Recordsetrecords.ActiveConnection = connsqlstr = "select * From Должности"records.Opensqlstrgrd1.Cleargrd1.Rows = 1grd1.Cols = 2grd1.TextMatrix(0, 0) = "Коддолжности"grd1.TextMatrix(0, 1) = "Должность"grd1.ColWidth(0) = 800grd1.ColWidth(1) = 2500c = 1r = 1Do While Not records.EOF grd1.Rows = grd1.Rows + 1 grd1.TextMatrix(r, 0) = records.Fields(0).Value grd1.TextMatrix(r, 1) = records.Fields(1).Valuerecords.MoveNext r = r + 1Looprecords.Closeconn.CloseEnd SubForm3.frmPrivate Sub Command1_Click()DlgOtdel.ShowDlgOtdel.bIsRed = False 'добавлениеновогоEnd SubPrivate Sub Command2_Click()DlgOtdel.ShowDlgOtdel.bIsRed = True 'редактированиеc = grd1.RowDlgOtdel.Text1.Text = grd1.TextMatrix(c, 1)DlgOtdel.iKodOtdela = grd1.TextMatrix(c, 0)End SubPrivate Sub Form_Load()GrdLoadEnd SubPublic Sub GrdLoad()Dim conn As ADODB.ConnectionDim constr, sqlstr, dbpath As StringSet conn = New ADODB.Connectiondbpath = App.Path & "\tabel.mdb"constr = "Provider= Microsoft.Jet.OLEDB.4.0;Data Source=" & dbpathconn.OpenconstrDim records As ADODB.RecordsetSet records = New ADODB.Recordsetrecords.ActiveConnection = connsqlstr = "select * From Отделы"records.Opensqlstrgrd1.Cleargrd1.Rows = 1grd1.Cols = 2grd1.TextMatrix(0, 0) = "Кодотдела"grd1.TextMatrix(0, 1) = "Отдел"grd1.ColWidth(0) = 800grd1.ColWidth(1) = 2500c = 1r = 1Do While Not records.EOF grd1.Rows = grd1.Rows + 1 grd1.TextMatrix(r, 0) = records.Fields(0).Value grd1.TextMatrix(r, 1) = records.Fields(1).Valuerecords.MoveNext r = r + 1Looprecords.Closeconn.CloseEnd SubForm4.frmPublic bIsEdit As BooleanPublic iKodSot As IntegerPrivate Sub cmdCancel_Click()Me.HideEnd SubPrivate Sub cmdSave_Click() Dim conS, strSQL, dbpath As String Dim tabnum As Integer Dim myCon As New ADODB.Connectiondbpath = App.Path & "\tabel.mdb"conS = "Provider= Microsoft.Jet.OLEDB.4.0;Data Source=" & dbpathmyCon.Open (conS)strSQL = "Select * from [Сотрудники]"Dim records As ADODB.RecordsetSet records = New ADODB.Recordsetrecords.ActiveConnection = myConrecords.OpenstrSQLrecords.CloseDim fio, sex, dayP, strdol, strotd As StringDim dol, otd As Integerfio = RTrim(LTrim(txtFIO.Text))sex = RTrim(LTrim(ComboS.Text))dayP = Combo1.Text & "." & Combo2.Texttabnum = Val(RTrim(LTrim(txtTabNum.Text)))ComboKodOtd.ListIndex = ComboOtd.ListIndexComboKodDol.ListIndex = ComboDol.ListIndexotd = ComboKodOtd.Textdol = ComboKodDol.TextIf bIsEdit = False ThenstrSQL = "INSERT INTO [Сотрудники] ([ТабельныйНомер], [ФИО], [Пол], [ДатаПоступления], [КодДолжности], [КодОтдела]) " & _ "Values('" & tabnum & "', '" & fio & "','" & sex & "', '" & dayP & "', '" & dol & "', '" & otd & "')" ElsestrSQL = "UPDATE Сотрудники SET ФИО = '" & fio & "', Пол='" & sex & "', ДатаПоступления = '" & dayP & "', КодДолжности = " & dol & ", КодОтдела = " & otd & " Where КодСотрудника = " & iKodSot & "" End IfmyCon.ExecutestrSQLmyCon.CloseForm5.GrdLoadMe.HideEnd SubPrivate Sub Form_Load()Dim iAs IntegerDim conS, sqlString As StringCombo1.AddItem ("Январь")Combo1.AddItem ("Февраль")Combo1.AddItem ("Март")Combo1.AddItem ("Апрель")Combo1.AddItem ("Май")Combo1.AddItem ("Июнь")Combo1.AddItem ("Июль")Combo1.AddItem ("Август")Combo1.AddItem ("Сентябрь")Combo1.AddItem ("Октябрь")Combo1.AddItem ("Ноябрь")Combo1.AddItem ("Декабрь")Combo1.ListIndex = 0Combo2.AddItem ("2007")Combo2.AddItem ("2008")Combo2.AddItem ("2009")Combo2.AddItem ("2010")Combo2.AddItem ("2011")Combo2.AddItem ("2012")Combo2.AddItem ("2013")Combo2.AddItem ("2014")Combo2.AddItem ("2015")Combo2.AddItem ("2016")Combo2.AddItem ("2017")Combo2.AddItem ("2018")Combo2.AddItem ("2019")Combo2.AddItem ("2020")Combo2.ListIndex = 6ComboS.AddItem ("М")ComboS.AddItem ("Ж")Dim conn As ADODB.ConnectionSet conn = New ADODB.ConnectionDim dbpath As Stringdbpath = App.Path & "\tabel.mdb"conS = "Provider= Microsoft.Jet.OLEDB.4.0;Data Source=" & dbpathconn.OpenconSDim records As ADODB.RecordsetSet records = New ADODB.Recordsetrecords.ActiveConnection = connsqlString = "select [Должность], КодДолжностиFrom [Должности]"records.OpensqlStringi = 1While Notrecords.EOFComboDol.AddItem (records(0))ComboKodDol.AddItem (records(1))records.MoveNexti = i + 1WendIf Not ComboDol.ListCount = 0 ThenComboDol.ListIndex = 0End Ifrecords.CloseSet records = New ADODB.Recordsetrecords.ActiveConnection = connsqlString = "select [Отдел], КодОтдела From [Отделы]"records.OpensqlStringi = 1While Notrecords.EOFComboOtd.AddItem (records(0))ComboKodOtd.AddItem (records(1))records.MoveNexti = i + 1WendIf Not ComboOtd.ListCount = 0 ThenComboOtd.ListIndex = 0End Ifrecords.Closeconn.CloseEnd SubForm5.frmPrivate Sub Command1_Click() Form4.Show Form4.bIsEdit = FalseEnd SubPrivate Sub Command2_Click()If grd1.Row = 0 Then Exit SubEnd Ifc = grd1.RowForm4.ShowForm4.bIsEdit = TrueIf grd1.Row = -1 Then Exit SubEnd IfForm4.txtFIO.Text = grd1.TextMatrix(c, 0) 'DataGrid1.TextForm4.txtTabNum.Text = grd1.TextMatrix(c, 1) 'DataGrid1.TextForm4.ComboS.Text = grd1.TextMatrix(c, 2) 'DataGrid1.TextForm4.Combo1.Text = Month(grd1.TextMatrix(c, 3)) 'Month(DataGrid1.Text)Form4.Combo2.Text = Year(grd1.TextMatrix(c, 3)) 'Year(DataGrid1.Text)Form4.ComboDol.Text = grd1.TextMatrix(c, 4) 'DataGrid1.TextForm4.ComboOtd.Text = grd1.TextMatrix(c, 5) 'DataGrid1.TextForm4.iKodSot = grd1.TextMatrix(c, 6)End SubPrivate Sub Form_Load()GrdLoadEnd SubPublic Sub GrdLoad()Dim conn As ADODB.ConnectionDim constr, sqlstr, dbpath As StringSet conn = New ADODB.Connectiondbpath = App.Path & "\tabel.mdb"constr = "Provider= Microsoft.Jet.OLEDB.4.0;Data Source=" & dbpathconn.OpenconstrDim records As ADODB.RecordsetSet records = New ADODB.Recordsetrecords.ActiveConnection = connsqlstr = "SELECTСотрудники.ФИО, Сотрудники.ТабельныйНомер, Сотрудники.Пол, Сотрудники.ДатаПоступления, Должности.Должность, Отделы.Отдел, Сотрудники.КодСотрудникаFrom Сотрудники, Должности, Отделы WHERE (((Сотрудники.КодДолжности)=[Должности].[КодДолжности]) AND ((Сотрудники.КодОтдела)=[Отделы].[КодОтдела]))"records.Opensqlstrgrd1.Cleargrd1.Rows = 1grd1.Cols = 7grd1.TextMatrix(0, 0) = "ФИО"grd1.TextMatrix(0, 1) = "ТабельныйНомер"grd1.TextMatrix(0, 2) = "Пол"grd1.TextMatrix(0, 3) = "ДатаПоступления"grd1.TextMatrix(0, 4) = "Должность"grd1.TextMatrix(0, 5) = "Отдел"grd1.TextMatrix(0, 6) = "Код"grd1.ColWidth(0) = 1800grd1.ColWidth(1) = 1000grd1.ColWidth(2) = 800grd1.ColWidth(3) = 1500grd1.ColWidth(4) = 1500grd1.ColWidth(5) = 1500grd1.ColWidth(6) = 10c = 1r = 1Do While Not records.EOF grd1.Rows = grd1.Rows + 1 grd1.TextMatrix(r, 0) = records.Fields(0).Value grd1.TextMatrix(r, 1) = records.Fields(1).Value grd1.TextMatrix(r, 2) = records.Fields(2).Value grd1.TextMatrix(r, 3) = records.Fields(3).Value grd1.TextMatrix(r, 4) = records.Fields(4).Value grd1.TextMatrix(r, 5) = records.Fields(5).Value grd1.TextMatrix(r, 6) = records.Fields(6).Valuerecords.MoveNext r = r + 1Looprecords.Closeconn.CloseEnd SubForm6.frmPrivate Sub Command1_Click()Form1.tabelName = "Табель" & List1.TextForm1.Label4 = "Табель" & List1.TextForm1.FillMsFlexGridMe.HideEnd SubPrivate Sub Command2_Click()Me.HideEnd SubPrivate Sub Form_Load()Dim conn As ADODB.ConnectionSet conn = New ADODB.Connectiondbpath = App.Path & "\tabel.mdb"constr = "Provider= Microsoft.Jet.OLEDB.4.0;Data Source=" & dbpathconn.OpenconstrDim rs As New ADODB.RecordsetSet rs = conn.OpenSchema(adSchemaTables)While Not rs.EOF If rs!TABLE_TYPE = "TABLE" Then If Mid(rs!TABLE_NAME, 1, 6) = "Табель" Then List1.AddItem (Mid(rs!TABLE_NAME, 7)) End If End Ifrs.MoveNextWendrs.Closeconn.CloseEnd SubDlgDol.frmPublic iKodDol As IntegerPublic bIsRed As BooleanPrivate Sub Command1_Click()Me.HideEnd SubPrivate Sub Command2_Click()Dim i As IntegerDim conS, sqlString, strSQL, dbpath As StringDim conn As ADODB.ConnectionSet conn = New ADODB.Connectiondbpath = App.Path & "\tabel.mdb"conS = "Provider= Microsoft.Jet.OLEDB.4.0;Data Source=" & dbpathconn.OpenconS Dim dol As Stringdol = RTrim(LTrim(Text1.Text))If Not dol = "" Then If bIsRed = False ThenstrSQL = "INSERTINTO Должности([Должность]) " & _"Values('" & dol & "')" ElsestrSQL = "UPDATE Должности " & _"SET Должность = '" & dol & "' whereКодДолжности =" & iKodDol & ""End Ifconn.ExecutestrSQLEnd Ifconn.Close Form2.GrdLoadMe.HideEnd SubPrivate Sub Form_Load()End SubDlgOtdel.frmPublic bIsRed As BooleanPublic iKodOtdela As IntegerPrivate Sub CancelButton_Click()Me.HideEnd SubPrivate Sub Form_Load()End SubPrivate Sub OKButton_Click()Dim i As IntegerDim conS, sqlString, strSQL, dbpath As StringDim conn As ADODB.ConnectionSet conn = New ADODB.Connectiondbpath = App.Path & "\tabel.mdb"conS = "Provider= Microsoft.Jet.OLEDB.4.0;Data Source=" & dbpathconn.OpenconS Dim otdel As Stringotdel = RTrim(LTrim(Text1.Text))If Not otdel = "" Then If bIsRed = False ThenstrSQL = "INSERT INTO Отделы([Отдел]) " & _ "Values('" & otdel & "')" ElsestrSQL = "UPDATE Отделы " & _ "SET Отдел = '" & otdel & "' where КодОтдела =" & iKodOtdela & "" End Ifconn.ExecutestrSQLEnd Ifconn.CloseForm3.GrdLoadDlgOtdel.HideEnd Sub