Банк Рефератов - Организация документооборота с помощью "Visual Basic for Application"

Главная: Рефераты

Рефераты. Организация документооборота с помощью "Visual Basic for Application"

stroka = stroka + 1

St = 1

For i = 1 To N_Day ' Установка подписей занятий

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

For i = 1 To DaysTimes

For j = 1 To N_Ayd

Cells(6 + j, i + 1) = 0 'Инициализация ячеек

For i = 4 To N + 3 ' Цикл по строкам заявок

If CStr(Worksheets(1).Cells(i, 7).Value) = "да" Then

' Выполнение условия по обслуживанию заявки

stroka = 0

For ia = 1 To N_Ayd

If CStr(Worksheets(1).Cells(i, 8).Value) = _

CStr(Cells(ia + 6, 1).Value) Then

stroka = ia + 6

Exit For

End If

If stroka > 0 And _

CStr(Worksheets(1).Cells(i, CInt(L1.Text) + 11).Value) = _

"*" Then

' Если есть строка с указанной аудиторией

For m = 1 To DaysTimes

' Нахождение столбца на листе для помещения заявки

If CStr(Worksheets(1).Cells(i, 4).Value) = _

CStr(Cells(5, 1 + m).Value) Then

If CStr(Worksheets(1).Cells(i, 5).Value) = _

CStr(Cells(6, 1 + m).Value) Then

stolbec = 1 + m

Exit For

End If

nomer = 1

For iy = 1 To N_Boss 'Определение заявителя в заявке

If CStr(Worksheets(1).Cells(i, 2).Value) _

= CStr(Worksheets(2).Cells(iy + 1, 6).Value) Then

nomer = iy

Exit For

End If

Cells(stroka, stolbec).Value = _

Cells(stroka, stolbec).Value + _

Worksheets(1).Cells(i, 6).Value

Cells(stroka, stolbec).Select

With Selection.Interior

.ColorIndex = colors(nomer) ' Установка заливки

.Pattern = xlSolid ' для ячейки

End With

End If

Range("a5").Select

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

For i = 1 To N_Ned

L1.AddItem Worksheets(2).Cells(i + 1, 3).Value

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

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

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

' Завершение цикла по количеству копированных заявок

' Удаление заявок

For oi = ColZ To 1 Step -1

i = mZ(oi)

Worksheets(1).Rows(i).Delete

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 <> ""

Страницы: 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24