LeroQ
Newbie | Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору Народ, завтра сдача курсовой, я не успеваю.Помогите пожалуйста, срочно надо, век не забуду( Сделать эти два задания, по примеру(Если можно - постучите в аську, я полностью все кину, а то я почти ничего не понимаю( Задание - Исходные данные о сотрудниках предприятия. Для каждого сотрудника задано: табельный номер, ФИО, год рождения, год поступления на предприятие, выполнение плана в %% за каждый квартал года. Число сотрудников не определено. Используя данные в файле, найти сотрудника с наименьшим выполнением плана за год. При этом необходимо обеспечить возможность: - создания файла; - добавления новых записей в файл; - удаления записи с заданным номером из файла; - корректировки записи с заданным номером в файле; - исправления табельного номера сотрудника; - сортировки записей в файле по суммарному выполнению плана за год (по возрастанию), затем по году поступления на предприятие (по убыванию), а внутри по табельному номеру; - просмотра содержимого файла после выполнения любой из перечисленных операций с файлом. Пример В качестве примера обработки файлов рассмотрим задачу 35. Для решения этой задачи создадим пользовательское меню по всем перечисленным пунктам задачи. То есть тут другая задача, но по примеру надо сделать, изменив все критерии. Программный код представлен далее. При этом в имени процедуры обработки меню первая цифра указывает номер уровня меню, а вторая номер меню в подуровне: Option Explicit Private Type Stud kurs As Byte gr As Byte fio As String * 20 pol As String * 1 god As Integer o(1 To 4) As Byte End Type Dim st As Stud 'Распечатка файла во время загрузки Private Sub Form_Load() Call mnu27_Click 'mnu27_Click End Sub 'Окончание работы программы Private Sub mnu12_Click() End End Sub 'Создание файла Private Sub mnu21_Click() Dim otv As String * 1 Dim i As Byte Dim j As Byte Open "fl.dat" For Random As #1 Len = Len(st) i = 0 Do i = i + 1 st.fio = InputBox("Введите ФИО " & i & "-го студента", "Ввод данных", _ , 2000, 500) st.kurs = CByte(InputBox("Введите номер курса [1-5] " & i & "-го студента", _ "Ввод данных", , 2000, 500)) st.gr = CByte(InputBox("Введите номер группы [1-5] " & i & "-го студента", _ "Ввод данных", , 2000, 500)) st.pol = InputBox("Введите пол [м или ж] " & i & "-го студента", _ "Ввод данных", , 2000, 500) st.god = CInt(InputBox("Введите год рождения " & i & "-го студента", _ "Ввод данных", , 2000, 500)) For j = 1 To 4 st.o(j) = CByte(InputBox("Введите оценку за " & j & "-ый экзамен [2-5] " & i & _ "-го студента", "Ввод данных", , 2000, 500)) Next Put #1, , st otv = InputBox("Введите Y, y, Д или д если хотите закончить ввод", _ "Ввод данных", , 2000, 500) Loop Until otv = "Y" Or otv = "y" Or otv = "Д" Or otv = "д" Close #1 ‘Call mnu27_Click End Sub 'Добавление записей в файл Private Sub mnu22_Click() Dim otv As String * 1 Dim i As Byte Dim j As Byte Open "fl.dat" For Random As #1 Len = Len(st) i = LOF(1) \ Len(st) Seek #1, i + 1 Do i = i + 1 With st .fio = InputBox("Введите ФИО " & i & "-го студента", "Ввод данных", _ , 2000, 500) .kurs = CByte(InputBox("Введите номер курса [1-5] " & i & "-го студента", _ "Ввод данных", , 2000, 500)) .gr = CByte(InputBox("Введите номер группы [1-5] " & i & "-го студента", _ "Ввод данных", , 2000, 500)) .pol = InputBox("Введите пол [м или ж] " & i & "-го студента", _ "Ввод данных", , 2000, 500) .god = CInt(InputBox("Введите год рождения " & i & "-го студента", _ "Ввод данных", , 2000, 500)) For j = 1 To 4 .o(j) = CByte(InputBox("Введите оценку за " & j & "-ый экзамен [2-5] " & i & _ "-го студента", "Ввод данных", , 2000, 500)) Next End With Put #1, , st otv = InputBox("Введите Y, y, Д или д если хотите закончить ввод", _ "Ввод данных", , 2000, 500) Loop Until otv = "Y" Or otv = "y" Or otv = "Д" Or otv = "д" Close #1 mnu27_Click End Sub 'Удаление записи с заданным номером Private Sub mnu23_Click() Dim num As Byte, i As Byte Open "fl.dat" For Random As #1 Len = Len(st) Open "New_fl.dat" For Random As #2 Len = Len(st) num = CByte(InputBox("Введите номер удаляемой записи ", _ "Ввод данных", , 2000, 500)) For i = 1 To num - 1 Get #1, , st Put #2, , st Next i Seek #1, num + 1 For i = num + 1 To LOF(1) \ Len(st) Get #1, , st Put #2, , st Next i Close #1, #2 Kill "fl.dat" Name "New_fl.dat" As "fl.dat" MsgBox "Запись с номером " & num & " успешно удалена." & vbCrLf & _ "Для продолжения нажми OK.", 64, "Результат удаления" Call mnu27_Click End Sub 'Корректировка записи Private Sub mnu24_Click() Dim num As Byte, j As Byte Open "fl.dat" For Random As #1 Len = Len(st) Text1.Text = Space(26) & "Экзамены" & vbCrLf Text1.Text = Text1.Text + _ "Курс Группа Пол Год р. 1-й 2-й 3-й 4-й ФИО" & vbCrLf num = CByte(InputBox("Введите номер корректируемой записи ", _ "Ввод данных", , 2000, 500)) Seek #1, num Get #1, , st Text1.Text = Text1.Text & " " & st.kurs & " " & st.gr Text1.Text = Text1.Text & " " & st.pol & " " & st.god & "" For j = 1 To 4 Text1.Text = Text1.Text & " " & st.o(j) Next j Text1.Text = Text1.Text & " " & st.fio & vbCrLf st.kurs = CByte(InputBox("Введите номер курса [1-5] " & num & "-го студента", _ "Ввод данных", st.kurs, 2000, 500)) Text1.Text = Text1.Text & " " & st.kurs st.gr = CByte(InputBox("Введите номер группы [1-5] " & num & "-го студента", _ "Ввод данных", st.gr, 2000, 500)) Text1.Text = Text1.Text & " " & st.gr st.pol = InputBox("Введите пол [м или ж] " & num & "-го студента", _ "Ввод данных", st.pol, 2000, 500) Text1.Text = Text1.Text & " " & st.pol st.god = CInt(InputBox("Введите год рождения " & num & "-го студента", _ "Ввод данных", st.god, 2000, 500)) Text1.Text = Text1.Text & " " & st.god & "" For j = 1 To 4 st.o(j) = CByte(InputBox("Введите оценку за " & j & "-ый экзамен [2-5] " & num & _ "-го студента", "Ввод данных", st.o(j), 2000, 500)) Text1.Text = Text1.Text & " " & st.o(j) Next st.fio = InputBox("Введите ФИО " & num & "-го студента", "Ввод данных", _ st.fio, 2000, 500) Text1.Text = Text1.Text & " " & st.fio & vbCrLf Seek #1, num Put #1, , st Close #1 End Sub 'Исправление фамилии Private Sub mnu25_Click() Dim name As String * 20, f As Boolean, j As Byte Open "fl.dat" For Random As #1 Len = Len(st) name = InputBox("Введите старую фамилию студента", "Ввод данных", _ , 2000, 500) Text1.Text = Space(26) & "Экзамены" & vbCrLf Text1.Text = Text1.Text + _ "Курс Группа Пол Год р. 1-й 2-й 3-й 4-й ФИО" & vbCrLf f = True Do While Not EOF(1) Get #1, , st If st.fio = name Then Text1.Text = Text1.Text & " " & st.kurs & " " & st.gr Text1.Text = Text1.Text & " " & st.pol & " " & st.god & "" For j = 1 To 4 Text1.Text = Text1.Text & " " & st.o(j) Next j Text1.Text = Text1.Text & " " & st.fio & vbCrLf f = False Exit Do End If Loop If f Then MsgBox "Таких студентов нет", 16, "Остановка" Else st.fio = InputBox("Введите новую фамилию " & Seek(1) - 1 & "-го студента", _ "Ввод данных", , 2000, 500) Text1.Text = Text1.Text & String(42, Asc("x")) & " " & st.fio & vbCrLf Seek #1, Seek(1) - 1 Put #1, , st End If Close #1 End Sub 'Сортировка записей Private Sub mnu26_Click() Dim st1 As Stud, f As Boolean, i As Byte, j As Byte Open "fl.dat" For Random As #1 Len = Len(st) f = True Do While f f = False For i = 1 To LOF(1) \ Len(st) - 1 For j = i + 1 To LOF(1) \ Len(st) Get #1, i, st Get #1, j, st1 If st.kurs > st1.kurs Then Put #1, i, st1 Put #1, j, st f = True ElseIf st.kurs = st1.kurs And st.gr > st1.gr Then Put #1, i, st1 Put #1, j, st f = True ElseIf st.kurs = st1.kurs And st.gr = st1.gr And st.fio > st1.fio Then Put #1, i, st1 Put #1, j, st f = True End If Next j Next i Loop Close #1 MsgBox "Записи успешно отсортированы." & vbCrLf & _ "Для продолжения нажми OK.", 64, "Результат сортировки" mnu27_Click End Sub 'Распечатка файла Private Sub mnu27_Click() Dim i As Byte, j As Byte Open "fl.dat" For Random As #1 Len = Len(st) Text1.Text = Space(26) & "Экзамены" & vbCrLf Text1.Text = Text1.Text + _ "Курс Группа Пол Год р. 1-й 2-й 3-й 4-й ФИО" & vbCrLf For i = 1 To LOF(1) \ Len(st) Get #1, , st Text1.Text = Text1.Text & " " & st.kurs & " " & st.gr Text1.Text = Text1.Text & " " & st.pol & " " & st.god & "" For j = 1 To 4 Text1.Text = Text1.Text & " " & st.o(j) Next j Text1.Text = Text1.Text & " " & st.fio & vbCrLf Next i Close #1 End Sub 'Лучший студент Private Sub mnu28_Click() Dim i As Byte, j As Byte, mx As Single, num As Byte, sr As Single Open "fl.dat" For Random As #1 Len = Len(st) Text1.Text = " Лучший студент" & vbCrLf Text1.Text = Text1.Text & Space(26) & "Экзамены" & vbCrLf Text1.Text = Text1.Text + _ "Курс Группа Пол Год р. 1-й 2-й 3-й 4-й ФИО" & vbCrLf mx = -1 For j = 1 To LOF(1) \ Len(st) Get #1, , st sr = 0 For i = 1 To 4 sr = sr + st.o(i) / 4 Next If mx < sr Then mx = sr num = Seek(1) - 1 End If Next j Get #1, num, st Text1.Text = Text1.Text & " " & st.kurs & " " & st.gr Text1.Text = Text1.Text & " " & st.pol & " " & st.god & "" For i = 1 To 4 Text1.Text = Text1.Text & " " & st.o(i) Next i Text1.Text = Text1.Text & " " & st.fio & vbCrLf Text1.Text = Text1.Text & "Средний бал = " & Format(mx, "0.0#") Close #1 End Sub Добавлено: И еще одно. Создать по заданным шаблонам в эмуляторе VB (Модули  Visual Data Manager) двух табличную базу данных Access или непосредственно в Access. Версии созданной базы данных и VB должны быть согласованы. Если простым сохранением файла базы данных положительного результата добиться не удается, то надо воспользоваться опцией “Сервис” в верхнем меню Access, затем “служебные программы”, далее “преобразовать базу данных”, потом “к предыдущей версии”. В каждой таблице количество записей больше десяти (может быть неодинаковое). Порядок записей в каждой таблице произвольный. Составить программу совместной обработки этих таблиц. Программа должна обеспечивать: А) Распечатать обе таблицы с заголовками. Б) Распечатать выходной документ в соответствии с заданным шаблоном. В) Распечатать справку для любой записи по заданному полю, включающую поля из обеих таблиц и два поля совместной обработки полей из разных таблиц. Кроме того, программа должна обеспечить возможность редактирования любой записи любой таблицы, удаления и добавления записей для любой таблицы. Задание - Шаблон таблицы 1: Фамилия Специальность Почасовая оплата в руб. Продолжительность рабочего дня Шаблон таблицы 2: Фамилия Количество отработанных дней в каждом месяце квартала Аванс в каждом месяце квартала Налог в %% Шаблон выходного документа: Фамилия Специальность К выдаче в конце каждого месяца квартала Справка по полю “Фамилия” Пример Программный код представлен далее: Для формы 1: Option Explicit Public k%, l%, i%, j% 'Справка по полю “Шифр предприятия” Private Sub Combo1_Click() Dim s! Form3.Show Form3.Data1.Recordset.Index = "Shizd" Form3.Data1.Recordset.Seek "=", Form1.Combo1.Text Form3.Data2.Recordset.Index = "Shiz" Form3.Data2.Recordset.Seek "=", Form1.Combo1.Text If Form3.Data2.Recordset.NoMatch Then Else s = 0 For i = 1 To 4 s = s + Form3.Data1.Recordset.Fields(i).Value Next Form3.Label1(8) = s * Form3.Data2.Recordset.Fields(2).Value Form3.Label1(9) = s * Form3.Data2.Recordset.Fields(3).Value End If Form3.MSFlexGrid1.Cols = 10 'Form3.Print Form3.MSFlexGrid1.ColWidth(1) Form3.MSFlexGrid1.ColWidth(1) = 700 Form3.MSFlexGrid1.ColWidth(2) = 1055 Form3.MSFlexGrid1.ColWidth(3) = 1055 Form3.MSFlexGrid1.ColWidth(4) = 1060 Form3.MSFlexGrid1.ColWidth(5) = 1060 'Form3.Print Form3.MSFlexGrid1.ColWidth(1) Form1.Data1.Recordset.MoveFirst Form2.Data1.Recordset.MoveFirst Form3.MSFlexGrid1.TextMatrix(0, 0) = "Название" Form3.MSFlexGrid1.TextMatrix(0, 1) = "Шифр" Form3.MSFlexGrid1.TextMatrix(0, 2) = "Сум.стоим.1" Form3.MSFlexGrid1.TextMatrix(0, 3) = "Сум.стоим.2" Form3.MSFlexGrid1.TextMatrix(0, 4) = "Сум.стоим.3" Form3.MSFlexGrid1.TextMatrix(0, 5) = "Сум.стоим.4" Form3.MSFlexGrid1.TextMatrix(0, 6) = "Сум. вес 1" Form3.MSFlexGrid1.TextMatrix(0, 7) = "Сум. вес 2" Form3.MSFlexGrid1.TextMatrix(0, 8) = "Сум. вес 3" Form3.MSFlexGrid1.TextMatrix(0, 9) = "Сум. вес 4" k = 1 For i = 1 To Form1.Data1.Recordset.RecordCount Form2.Data1.Recordset.MoveFirst For j = 1 To Form2.Data1.Recordset.RecordCount 'Shizd=Shiz If Form1.Data1.Recordset.Fields(5) = Form2.Data1.Recordset.Fields(0) Then Form3.MSFlexGrid1.Rows = k + 1 Form3.MSFlexGrid1.TextMatrix(k, 0) = Form1.Data1.Recordset.Fields(0) Form3.MSFlexGrid1.TextMatrix(k, 1) = Form1.Data1.Recordset.Fields(5) For l = 1 To 4 Form3.MSFlexGrid1.TextMatrix(k, l + 1) = _ Form1.Data1.Recordset.Fields(l).Value * Form2.Data1.Recordset.Fields(2).Value Form3.MSFlexGrid1.TextMatrix(k, l + 5) = _ Form1.Data1.Recordset.Fields(l).Value * Form2.Data1.Recordset.Fields(3).Value Next l k = k + 1 End If Form2.Data1.Recordset.MoveNext Next j Form1.Data1.Recordset.MoveNext Next i Form1.Data1.Recordset.MoveFirst Form2.Data1.Recordset.MoveFirst End Sub 'Вывести таблицу "Поставка" Private Sub Command1_Click() Data1.Recordset.MoveFirst Flp.Rows = Data1.Recordset.RecordCount + 1: Flp.Cols = 6 Flp.TextMatrix(0, 0) = "Название" Flp.TextMatrix(0, 1) = "Поставка 1 кв" Flp.TextMatrix(0, 2) = "Поставка 2 кв" Flp.TextMatrix(0, 3) = "Поставка 3 кв" Flp.TextMatrix(0, 4) = "Поставка 4 кв" Flp.TextMatrix(0, 5) = "Шифр" Data1.Recordset.MoveFirst For i = 1 To Data1.Recordset.RecordCount For j = 1 To 6 'Text1(j - 1).Text Flp.TextMatrix(i, j - 1) = Data1.Recordset.Fields(j - 1) Next j Data1.Recordset.MoveNext Next i Data1.Recordset.MoveFirst List1.Clear Combo1.Clear For i = 1 To Data1.Recordset.RecordCount List1.List(i - 1) = Data1.Recordset.Fields(0) Combo1.List(i - 1) = Data1.Recordset.Fields(5) Data1.Recordset.MoveNext Next i Data1.Recordset.MoveFirst End Sub 'Удалить запись Private Sub Command2_Click() Dim Reply As VbMsgBoxResult Reply = MsgBox("Если будете удалять текущую запись, нажмите кнопку OK", _ vbOKCancel, "Удаление текущей записи") If Reply = vbOK Then Data1.Recordset.Delete Data1.Recordset.MoveFirst End If End Sub 'Закончить проект Private Sub Command3_Click() End End Sub 'Показать форму 2 Private Sub Command4_Click() Form2.Show Form2.Fli.TextMatrix(0, 0) = "Шифр" Form2.Fli.TextMatrix(0, 1) = "Название" Form2.Fli.TextMatrix(0, 2) = "Цена" Form2.Fli.TextMatrix(0, 3) = "Вес" End Sub 'Добавить запись Private Sub Command5_Click() Dim Reply As VbMsgBoxResult Reply = MsgBox("Если будете вводить новую запись, нажмите кнопку OK", _ vbOKCancel, "Ввод новой записи") If Reply = vbOK Then Text1(0).SetFocus 'Остановка, текстовые окна пустые, после их заполнения Data1.Recordset.AddNew 'нажать левую стрелку объекта Data, новая запись - последняя End If End Sub 'Обработка таймера Private Sub Timer1_Timer() Label3.Caption = Date & Space(2) & Time End Sub Для формы 2: Option Explicit 'Удаление записи Private Sub Command1_Click() Dim Reply As VbMsgBoxResult Reply = MsgBox("Если будете удалять текущую запись, нажмите кнопку OK", _ vbOKCancel, "Удаление текущей записи") If Reply = vbOK Then Data1.Recordset.Delete Data1.Recordset.MoveFirst End If End Sub 'Добавление записи Private Sub Command2_Click() Dim Reply As VbMsgBoxResult Reply = MsgBox("Если будете вводить новую запись, нажмите кнопку OK", _ vbOKCancel, "Ввод новой записи") If Reply = vbOK Then Text1(0).SetFocus 'Остановка, текстовые окна пустые, после их заполнения Data1.Recordset.AddNew 'нажать левую стрелку объекта Data, новая запись - последняя End If End Sub Для формы 3: Option Explicit Извините за флуд, но поймите, как человека, завтра последний день( |