Организация документооборота с помощью "Visual Basic for Application"
Visual Basic for Application. Объекты и коллекции. Использование VBA в среде Access. Основы современной технологии проектирования АИС. Автоматизированное проектированиеCASE-технологий. Реинжиниринг бизнес-процессов и проектирование корпоративной ИС.
| Рубрика | Программирование, компьютеры и кибернетика |
| Вид | курсовая работа |
| Язык | русский |
| Дата добавления | 22.02.2008 |
| Размер файла | 2,1 M |
Отправить свою хорошую работу в базу знаний просто. Используйте форму, расположенную ниже
Студенты, аспиранты, молодые ученые, использующие базу знаний в своей учебе и работе, будут вам очень благодарны.
L1.AddItem Worksheets(2).Cells(i + 1, 3).Value
Next
If L1.ListCount > 0 And Sav1 < L1.ListCount Then
L1.ListIndex = Sav1
End If
End Sub
Private Sub Worksheet_Deactivate()
Sav1 = L1.ListIndex
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
' Вычисление строки и столбца выделенной ячейки
stroka = ActiveCell.Row
stolbec = ActiveCell.Column
If stolbec <> 1 Then
' Информационное окно видимо только при выделении первой колонки
Inf1.Visible = False
ElseIf stroka > 6 Then
Inf1.Visible = True
Inf1.Text = "Вместимость " + _
Str(Worksheets(2).Cells(stroka - 5, 2)) + "чел"
End If
End Sub
Процедуры листа отчет 3
Private Sub Com_2_Click()
' Номера строки и столбца выделенной заявки
NumStr = ActiveCell.Row
NumCol = ActiveCell.Column
If NumStr < 7 Or NumCol < 2 Then
Exit Sub
End If
Vrem = CStr(Cells(6, NumCol)) ' Вычисление времени и дня времени занятия
Den = CStr(Cells(5, NumCol))
aud = CStr(Cells(NumStr, 1))
ColZ = 0 ' Подсчет заявок в выделенной ячейке
N = 0 ' Подсчет количества заявок на первом листе
While Worksheets(1).Cells(N + 4, 1).Value <> ""
N = N + 1
Wend
For i = 1 To N ' Цикл по количеству заявок
Day1 = CStr(Worksheets(1).Cells(i + 3, 4).Value)
Time1 = CStr(Worksheets(1).Cells(i + 3, 5).Value)
Aud1 = CStr(Worksheets(1).Cells(i + 3, 8).Value)
indicator = 0
If Time1 = Vrem And Day1 = Den And aud = Aud1 Then
For j = CInt(L1.Text) To CInt(L2.Text)
If Worksheets(1).Cells(i + 3, 11 + j).Value = "*" Then
'indicator = 1
ColZ = ColZ + 1
mZ(ColZ) = i + 3
Exit For
End If
Next
End If
Next
Cells(NumStr, NumCol).Select
With Selection.Interior
.ColorIndex = 38
.Pattern = xlSolid
End With
End Sub
Private Sub Com_3_Click()
row7 = ActiveCell.Row ' Вычисление номера столбца и строки
col7 = ActiveCell.Column
Symma = Cells(NumStr, NumCol).Value ' Итоговая сумма копируемой ячейки
N = 0 ' Вычисление числа строк на первом листе
While Worksheets(1).Cells(N + 4, 1).Value <> ""
N = N + 1
Wend
NNa = 0 ' Число аудиторий на первом листе
While Worksheets(2).Cells(NNa + 2, 1).Value <> ""
NNa = NNa + 1
Wend
audN = CStr(Cells(row7, 1)) ' Значения аудитории, дня и времени выделенной
denN = CStr(Cells(5, col7)) ' ячейки
vremZ = CStr(Cells(6, col7))
flagZ = 0 'Индикатор возможности перемещения заявок
For i = 4 To N + 3 ' Проверка занятий
For j = 1 To ColZ
If i = mZ(j) Then
GoTo Nexti2 ' Обходим копируемую заявку
End If
Next
a_i = CStr(Worksheets(1).Cells(i, 8).Value)
d_i = CStr(Worksheets(1).Cells(i, 4).Value)
v_i = CStr(Worksheets(1).Cells(i, 5).Value)
o_i = CStr(Worksheets(1).Cells(i, 7).Value)
If o_i <> "да" Then ' Если заявка необслужена, то ее обходим
GoTo Nexti2
End If
For j = 1 To ColZ ' Цикл по количеству перемещаемых заявок
If audN = a_i And denN = d_i And vremZ = v_i Then
' При совпадении аудитории, дня и времени
For m = 0 To 17
If Worksheets(1).Cells(i, 11 + m).Value = "*" _
And Worksheets(1).Cells(mZ(j), 11 + m).Value = "*" Then
flagZ = 1 ' Если есть перекрытие хотя бы по одной неделе,
Exit For ' то копирование невозможно
End If
Next ' Цикл по неделям
End If
If flagZ = 1 Then
Exit For
End If
Next ' Цикл по количеству перемещаемых заявок
If flagZ = 1 Then
Exit For
End If
Nexti2: Next ' Завершение проверки
If flagZ = 1 Then ' Если копирование невозможно, то выводим соответствующее сообщение
MsgBox ("Заявку не удается перенести. Аудиторное время занято.")
Max1 = CInt(L2.Text) - CInt(L1.Text) + 1
porog1 = CInt(Max1 / 2)
row7 = NumStr
col7 = NumCol
a = CInt(Cells(row7, col7).Value)
If a = 0 Then
ElseIf a = Max1 Then
Cells(row7, col7).Select
With Selection.Interior
.ColorIndex = 7
.Pattern = xlSolid
End With
ElseIf a <= porog1 Then
Cells(row7, col7).Select
With Selection.Interior
.ColorIndex = 8
.Pattern = xlSolid
End With
ElseIf a > porog1 And a < Max1 Then
Cells(row7, col7).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
End With
End If
Exit Sub
End If
'Цикл по количеству копированных заявок
Worksheets(1).Unprotect
For ia = 1 To ColZ
Nom = 0
While Worksheets(1).Cells(Nom + 4, 1).Value <> ""
Nom = Nom + 1
Wend
Worksheets(1).Cells(Nom + 4, 1).Value = Worksheets(1).Cells(mZ(ia), 1).Value
Worksheets(1).Cells(Nom + 4, 2).Value = Worksheets(1).Cells(mZ(ia), 2).Value
Worksheets(1).Cells(Nom + 4, 3).Value = Worksheets(1).Cells(mZ(ia), 3).Value
Worksheets(1).Cells(Nom + 4, 4).Value = denN
Worksheets(1).Cells(Nom + 4, 5).Value = vremZ
Worksheets(1).Cells(Nom + 4, 6).Value = Worksheets(1).Cells(mZ(ia), 6).Value
Worksheets(1).Cells(Nom + 4, 7).Value = Worksheets(1).Cells(mZ(ia), 7).Value
Worksheets(1).Cells(Nom + 4, 8).Value = audN
For uo = 9 To 28
Worksheets(1).Cells(Nom + 4, uo).Value = Worksheets(1).Cells(mZ(ia), uo).Value
Next
Next
' Завершение цикла по количеству копированных заявок
' Удаление заявок
For oi = ColZ To 1 Step -1
i = mZ(oi)
Worksheets(1).Rows(i).Delete
Next
Worksheets(1).Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Cells(NumStr, NumCol).Value = "0"
Cells(NumStr, NumCol).Select
With Selection.Interior
.ColorIndex = 0
.Pattern = xlSolid
End With
Max1 = CInt(L2.Text) - CInt(L1.Text) + 1
porog1 = CInt(Max1 / 2)
Cells(row7, col7).Value = Symma
If Symma = 0 Then
Cells(row7, col7).Select
With Selection.Interior
.ColorIndex = 7
.Pattern = xlSolid
End With
ElseIf Symma = Max1 Then
Cells(row7, col7).Select
With Selection.Interior
.ColorIndex = 7
.Pattern = xlSolid
End With
ElseIf Symma <= porog1 Then
Cells(row7, col7).Select
With Selection.Interior
.ColorIndex = 8
.Pattern = xlSolid
End With
ElseIf Symma > porog1 And Symma < Max1 Then
Cells(row7, col7).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
End With
End If
End Sub
Private Sub CommandButton1_Click()
' Очистка области листа со старыми данными
Range("a5:AZ100").Select
Selection.ClearContents
Range("a1").Select
' Убираем с экрана информационное окно
T1.Visible = False
' Подсчет количества учебный дней в неделе
N_Days = 0
While Worksheets(2).Cells(N_Days + 2, 4).Value <> ""
N_Days = N_Days + 1
Wend
' Подсчет количества занятий в течение дня
N_Times = 0
While Worksheets(2).Cells(N_Times + 2, 5).Value <> ""
N_Times = N_Times + 1
Wend
' Подсчет количества аудиторий
N_Rooms = 0
While Worksheets(2).Cells(N_Rooms + 2, 1).Value <> ""
N_Rooms = N_Rooms + 1
Wend
' Расчет количества занятий в течение недели
DaysTimes = N_Days * N_Times
For i = 1 To DaysTimes
For j = 1 To N_Rooms
Cells(6 + j, i + 1) = 0
Next
Next
' Подсчет числа заявителей
N_Boss = 0
While Worksheets(2).Cells(N_Boss + 2, 6).Value <> ""
N_Boss = N_Boss + 1
Wend
Range("b7:AZ100").Select ' Заливка белым цветом области вывода
With Selection.Interior
.ColorIndex = 0
.Pattern = xlSolid
End With
' Подсчет количества строк на 1-м листе
N = 0
While Worksheets(1).Cells(N + 4, 1).Value <> ""
N = N + 1
Wend
' Вывод информации начинаем с седьмой строки
stroka = 7
For i = 1 To N_Rooms ' Заполнение столбца аудиторий
Cells(stroka, 1).Value = Worksheets(2).Cells(i + 1, 1).Value
stroka = stroka + 1
Next
St = 1 ' Заполнение дней и начала занятий
For i = 1 To N_Days
For j = 1 To N_Times
St = St + 1
Cells(5, St).Value = Worksheets(2).Cells(i + 1, 4).Value
Cells(6, St).Value = Worksheets(2).Cells(j + 1, 5).Value
Next
Next
N_Ayd = 0 ' Подсчет аудитоий занесенных на этот лист
While Cells(N_Ayd + 7, 1).Value <> ""
N_Ayd = N_Ayd + 1
Wend
For j = CInt(L1.Text) To CInt(L2.Text) ' Цикл по указанным неделям
For i = 4 To N + 3 ' Цикл по строкам первого листа
If CStr(Worksheets(1).Cells(i, 7).Value) = _
"да" Then ' Если заявка обслужена
Nayd = Worksheets(1).Cells(i, 8).Value
stroka = 0
For m = 1 To N_Rooms
If CStr(Nayd) = CStr(Cells(m + 6, 1).Value) Then
stroka = m + 6
Exit For
End If
Next
' Если не найдена аудитория указанная в строке на первом листе
If stroka = 0 Then
inform_text = "Ошибка в данных в строке " + CStr(i)
MsgBox (inform_text)
'Worksheets(1).Cells(i, 1).Activate
Range("A1").Select
Exit Sub
End If
For m = 1 To DaysTimes
If CStr(Worksheets(1).Cells(i, 4).Value) = CStr(Cells(5, 1 + m).Value) _
And CStr(Worksheets(1).Cells(i, 5).Value) = CStr(Cells(6, 1 + m).Value) Then
stolbec = 1 + m
Exit For
End If
Next
' Фрагмент для учета групповых занятий
If Worksheets(1).Cells(i, j + 11).Value = "*" And Cells(stroka, stolbec).Value < 1000 Then
Cells(stroka, stolbec) = Cells(stroka, stolbec) + 1
Cells(stroka, stolbec) = Cells(stroka, stolbec) + 1000
End If
End If
Next
For ii = 1 To DaysTimes
For jj = 1 To N_Rooms
a = CInt(Cells(jj + 6, ii + 1).Value)
If a >= 1000 Then
Cells(jj + 6, ii + 1).Value = Cells(jj + 6, ii + 1).Value - 1000
End If
Next
Next
Next
' Расцветка занятий
Maximum = CInt(L2.Text) - CInt(L1.Text) + 1
porog = CInt(Maximum / 2) ' Порог - половина занятых дней в указанном интервале
For i = 1 To DaysTimes
For j = 1 To N_Rooms
a = CInt(Cells(j + 6, i + 1).Value) ' Количество занятий
If a = Maximum Then
Cells(j + 6, i + 1).Select
With Selection.Interior
.ColorIndex = 7 ' Расцветка при максимальной занятости
.Pattern = xlSolid
End With
ElseIf a <= porog And a > 0 Then
Cells(j + 6, i + 1).Select
With Selection.Interior
.ColorIndex = 8 ' Расцветка при знятости меньше среней
.Pattern = xlSolid
End With
ElseIf a > porog And a < Maximum Then
Cells(j + 6, i + 1).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
End With
End If
Next
Next
Range("a5").Select
T1.Visible = True
End Sub
Private Sub CommandButton2_Click()
F_Podbor.Show
End Sub
Private Sub T1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
T1.Text = ""
T1.Visible = False
End Sub
Private Sub Worksheet_Activate()
N_Ned = 0
While Worksheets(2).Cells(N_Ned + 2, 3).Value <> ""
N_Ned = N_Ned + 1
Wend
L1.Clear
L2.Clear
For i = 1 To N_Ned
L1.AddItem Worksheets(2).Cells(i + 1, 3).Value
L2.AddItem Worksheets(2).Cells(i + 1, 3).Value
Next
If L1.ListCount > 0 And Sav1 < L1.ListCount Then
L1.ListIndex = Sav1
End If
If L2.ListCount > 0 And Sav2 < L2.ListCount Then
L2.ListIndex = Sav2
End If
Private Sub Worksheet_Deactivate()
Sav1 = L1.ListIndex
Sav2 = L2.ListIndex
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
NumStr1 = ActiveCell.Row
NumCol1 = ActiveCell.Column
If NumCol1 <> 1 Then
If T1.Visible = False Then
Exit Sub
End If
T1.Text = ""
N_Days = 0
While Worksheets(2).Cells(N_Days + 2, 4).Value <> ""
N_Days = N_Days + 1
Wend
N_Times = 0
While Worksheets(2).Cells(N_Times + 2, 5).Value <> ""
N_Times = N_Times + 1
Wend
' Количество строк
DaysTimes = N_Days * N_Days
N = 0
While Worksheets(1).Cells(N + 4, 1).Value <> ""
N = N + 1
Wend
'Цикл по строкам первого листа
For i = 1 To N
Day1 = CStr(Worksheets(1).Cells(i + 3, 4).Value)
Time1 = CStr(Worksheets(1).Cells(i + 3, 5).Value)
Group1 = CStr(Worksheets(1).Cells(i + 3, 9).Value)
Prepod1 = CStr(Worksheets(1).Cells(i + 3, 3).Value)
Disp1 = CStr(Worksheets(1).Cells(i + 3, 10).Value)
Aud1 = CStr(Worksheets(1).Cells(i + 3, 8).Value)
Obs1 = CStr(Worksheets(1).Cells(i + 3, 7).Value)
' Если заявка обслужена
If Obs1 = "да" Then
indic = 0
For j = CInt(L1.Text) To CInt(L2.Text)
If CStr(Worksheets(1).Cells(i + 3, 10 + j).Value) = "*" Then
indic = 1
Exit For
End If
Next
' Если интервал недель соответстует
If indic = 1 Then
If Day1 = CStr(Cells(5, NumCol1).Value) And _
Time1 = CStr(Cells(6, NumCol1).Value) _
And CStr(Cells(NumStr1, 1).Value) = Aud1 Then
If T1.Text <> "" Then
T1.Text = T1.Text + Chr(10)
End If
T1.Text = T1.Text + Disp1
T1.Text = T1.Text + " " + Group1
T1.Text = T1.Text + " " + Prepod1 + " "
For j = CInt(L1.Text) To CInt(L2.Text) 'Цикл 1
ask = CStr(Worksheets(1).Cells(i + 3, j + 11).Value)
If ask = "*" Then
T1.Text = T1.Text + " " + Str(j) + ","
End If
Next
End If
End If ' Если интервал недель соответстует
End If 'Если заявка обслужена
Next 'Завершение цикла по строкам первого листа
T3.Visible = False
ElseIf NumStr1 > 6 Then
T3.Visible = True
T3.Text = "Вместимость " + Str(Worksheets(2).Cells(NumStr1 - 5, 2)) + " чел "
End If
End Sub
Приложение 2
Процедура, связанная с открытием книги
Private Sub Workbook_Open()
' Подсчет дней на втором листе
N_Days = 0
While Worksheets(2).Cells(N_Days + 2, 4).Value <> ""
N_Days = N_Days + 1
Wend
' Заполнение списка L1 на 3-м листе
Worksheets(3).L1.Clear
For i = 1 To N_Days
Worksheets(3).L1.AddItem Worksheets(2).Cells(i + 1, 4).Value
Next
' Подсчет занятий в течение дня
N_Times = 0
While Worksheets(2).Cells(N_Times + 2, 5).Value <> ""
N_Times = N_Times + 1
Wend
' Заполнение списка L2 на 3-м листе
Worksheets(3).L2.Clear
For i = 1 To N_Times
Worksheets(3).L2.AddItem CStr(Worksheets(2).Cells(i + 1, 5).Value)
Next
' Подсчет числа недель на втором листе
N_Ned = 0
While Worksheets(2).Cells(N_Ned + 2, 3).Value <> ""
N_Ned = N_Ned + 1
Wend
' Заполнение 3-го списка L3 на 3-м листе
Worksheets(3).L3.Clear
For i = 1 To N_Ned
Worksheets(3).L3.AddItem Worksheets(2).Cells(i + 1, 3).Value
Next
' Заполнение списков недель на 4-м листе
Worksheets(4).C1.Clear
Worksheets(4).C2.Clear
For i = 1 To N_Ned
Worksheets(4).C1.AddItem Worksheets(2).Cells(i + 1, 3).Value
Worksheets(4).C2.AddItem Worksheets(2).Cells(i + 1, 3).Value
Next
' Заполнение списка недель на 8-м листе
Worksheets(8).L1.Clear
For i = 1 To N_Ned
Worksheets(8).L1.AddItem Worksheets(2).Cells(i + 1, 3).Value
Next
' Заполнение списка недель на 9-м листе
Worksheets(9).L1.Clear
Worksheets(9).L2.Clear
For i = 1 To N_Ned
Worksheets(9).L1.AddItem Worksheets(2).Cells(i + 1, 3).Value
Worksheets(9).L2.AddItem Worksheets(2).Cells(i + 1, 3).Value
Next
'Заполнение списка недель на 10-м листе
Worksheets(10).L1.Clear
Worksheets(10).L2.Clear
For i = 1 To N_Ned
Worksheets(10).L1.AddItem Worksheets(2).Cells(i + 1, 3).Value
Worksheets(10).L2.AddItem Worksheets(2).Cells(i + 1, 3).Value
Next
' Подсчет числа преподавателей
N_Prepod = 0
While Worksheets(2).Cells(N_Prepod + 2, 7).Value <> ""
N_Prepod = N_Prepod + 1
Wend
' Заполнение списка преподавателей на листе Нагрузка
Worksheets(12).Prepod.Clear
For i = 1 To N_Prepod
Worksheets(12).Prepod.AddItem Worksheets(2).Cells(i + 1, 7).Value
Next
Worksheets(11).mesac.Clear
Worksheets(11).mesac.AddItem "сентябрь"
Worksheets(11).mesac.AddItem "октябрь"
Worksheets(11).mesac.AddItem "ноябрь"
Worksheets(11).mesac.AddItem "декабрь"
Worksheets(11).mesac.AddItem "январь"
Worksheets(11).mesac.AddItem "февраль"
Worksheets(11).mesac.AddItem "март"
Worksheets(11).mesac.AddItem "апрель"
Worksheets(11).mesac.AddItem "май"
Worksheets(11).mesac.AddItem "июнь"
' Установка защиты на первый и второй листы
Worksheets(1).Protect DrawingObjects:=True, Contents:=True, _
Scenarios:=True
Worksheets(2).Protect DrawingObjects:=True, Contents:=True, _
Scenarios:=True
End Sub
СПИСОК ЛИТЕРАТУРЫ
1 Смирнов Г.Н. «Проектирование экономических информационных систем». Учебник.-М.: Финансы и статистика, 2003.
2. Емельянова Н.З. и др. «Основы построения автоматизированных систем». Учебное пособие. - М.: Форум: ИНФРА-М,2005.
3. Гарнаев А.Ю. «Самоучитель VBA.» СПБ.:БХВ-Петеребург,2004.
4. Уокенбах Д. «Профессиональное программирование на VBA в Exel 2002».: Перевод с английского. - М.: Издательский дом «Вильямс», 2003
Размещено на Allbest.ru
Подобные документы
Решение экономических задач с помощью Microsoft Excel и инструментария Visual Basic For Application. Способы запуска редактора Visual Basic, правила его синтаксиса. Создание автоматических макросов по сортировке и выборке. Создание управляющих кнопок.
курсовая работа [852,0 K], добавлен 24.09.2010Характеристика мови програмування VBA (Visual Basic for Application): можливості й засоби. Використання редактора Visual Basic. Створення та виконання VBA-програм. Типи даних, змінні й константи, операції й вирази. Керуючі оператори, процедури й функції.
реферат [29,9 K], добавлен 28.06.2011Программа обработки одномерного массива средствами Visual Basic for Application (VBA) на предмет преобразования, печати, удаления, сортировки, поиска сумм, положительных, чётных элементов, их кратности и дополнения другими элементами и значениями данных.
контрольная работа [12,3 K], добавлен 07.10.2012Характеристика системы программирования Visual Basic For Application. Автоматизация подписки на газеты и журналы, а так же их учёт. Связь между сходными документами, Базой данных и выходными документами. Встроенные объекты MS Access, методы и свойства.
курсовая работа [350,8 K], добавлен 22.09.2012Напівфункціональна мова програмування, складова частина Access - Visual Basic for Applications (VBA). Створення коду VBA за допомогою майстрів елементів управління. Модулі, створення процедур обробки подій. Редагування у вікні модуля, аргументи процедури.
реферат [144,8 K], добавлен 31.08.2009Язык программирования Visual Basic: краткая история возникновения, значение и общая характеристика. Изучение основных свойств Visual Basic, синтаксис языка. Обзор ключевых операторов Visual Basic, пользовательские процедуры и функции данного языка.
контрольная работа [36,4 K], добавлен 23.07.2014Формирование матрицы и выполнение заданий: вычисление сумы четных элементов; максимума из нечетных элементов в строке; произведение элементов в нечетных столбцах; количество четных элементов выше главной диагонали. Создание программы в Visual Basic.
контрольная работа [12,0 K], добавлен 07.10.2012Рождение и развитие Basic. Краткое описание Visual Basic for Applications. Новые возможности Visual Basic 5.0. Пример взаимодействия Excel и Visual Basic. Программирование табличных функций. Встраивание, применение функций. Формы, средства управления OLE.
реферат [20,7 K], добавлен 11.03.2010Рабочая среда Visual Basic (VB) и ее основные компоненты. Ввод и вывод данных в VB. Объявление переменных и констант в программе. Создание и работа с процедурами и функциями, их виды. Организация ветвления в VB. Использование циклов в программировании.
практическая работа [502,5 K], добавлен 26.10.2013Программный проект Баз данных средствами Visual Basic 6.0. Проектирование структуры таблицы базы данных Visual Basic 6.0. Заполнение созданных таблиц БД исходными данными. Создание пользовательского меню. Вид формы и свойства элементов управления.
курсовая работа [3,0 M], добавлен 19.06.2010
