Форма Perevod 2 (перевод единиц времени, возврат к расчётной форме)

'Перевод единиц времени

Private Sub CommandButton1_Click()

Hide

SolForm.Show

If ActiveSheet.Cells(1, 1).Value = "№" Then

If edin = 1 Then

If Minutes.Value = True Then

Exit Sub

End If

If Chas.Value = True Then

For i = 2 To n + 1

For j = 2 To n + 1

If Not ActiveSheet.Cells(i, j).Value = "" Then

ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value / 60

End If

Next j

Next i

End If

If Sutki.Value = True Then

For i = 2 To n + 1

For j = 2 To n + 1

If Not ActiveSheet.Cells(i, j).Value = "" Then

ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value / 1440

End If

Next j

Next i

End If

If Nedeli.Value = True Then

For i = 2 To n + 1

For j = 2 To n + 1

If Not ActiveSheet.Cells(i, j).Value = "" Then

ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value / 10080

End If

Next j

Next i

End If

If Mes.Value = True Then

MsgBox "Точный перевод невозможен. Попробуйте другой вариант", vbCritical + vbOKOnly, "Ошибка ввода"

End If

If Godi.Value = True Then

For i = 2 To n + 1

For j = 2 To n + 1

If Not ActiveSheet.Cells(i, j).Value = "" Then

ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value / 525600

End If

Next j

Next i

End If

End If

If edin = 2 Then

If Minutes.Value = True Then

For i = 2 To n + 1

For j = 2 To n + 1

If Not ActiveSheet.Cells(i, j).Value = "" Then

ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value * 60

End If

Next j

Next i

End If

If Chas.Value = True Then

Exit Sub

End If

If Sutki.Value = True Then

For i = 2 To n + 1

For j = 2 To n + 1

If Not ActiveSheet.Cells(i, j).Value = "" Then

ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value / 24

End If

Next j

Next i

End If

If Nedeli.Value = True Then

For i = 2 To n + 1

For j = 2 To n + 1

If Not ActiveSheet.Cells(i, j).Value = "" Then

ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value / 168

End If

Next j

Next i

End If

If Mes.Value = True Then

MsgBox "Точный перевод невозможен. Попробуйте другой вариант", vbCritical + vbOKOnly, "Ошибка ввода"

End If

If Godi.Value = True Then

For i = 2 To n + 1

For j = 2 To n + 1

If Not ActiveSheet.Cells(i, j).Value = "" Then

ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value / 8760

End If

Next j

Next i

End If

End If

If edin = 3 Then

If Minutes.Value = True Then

For i = 2 To n + 1

For j = 2 To n + 1

If Not ActiveSheet.Cells(i, j).Value = "" Then

ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value * 1440

End If

Next j

Next i

End If

If Chas.Value = True Then

For i = 2 To n + 1

For j = 2 To n + 1

If Not ActiveSheet.Cells(i, j).Value = "" Then

ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value * 24

End If

Next j

Next i

End If

If Sutki.Value = True Then

Exit Sub

End If

If Nedeli.Value = True Then

For i = 2 To n + 1

For j = 2 To n + 1

If Not ActiveSheet.Cells(i, j).Value = "" Then

ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value / 7

End If

Next j

Next i

End If

If Mes.Value = True Then

MsgBox "Точный перевод невозможен. Попробуйте другой вариант", vbCritical + vbOKOnly, "Ошибка ввода"

End If

If Godi.Value = True Then

For i = 2 To n + 1

For j = 2 To n + 1

If Not ActiveSheet.Cells(i, j).Value = "" Then

ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value / 365

End If

Next j

Next i

End If

End If

If edin = 4 Then

If Minutes.Value = True Then

For i = 2 To n + 1

For j = 2 To n + 1

If Not ActiveSheet.Cells(i, j).Value = "" Then

ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value * 10080

End If

Next j

Next i

End If

If Chas.Value = True Then

For i = 2 To n + 1

For j = 2 To n + 1

If Not ActiveSheet.Cells(i, j).Value = "" Then

ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value * 168

End If

Next j

Next i

End If

If Sutki.Value = True Then

For i = 2 To n + 1

For j = 2 To n + 1

If Not ActiveSheet.Cells(i, j).Value = "" Then

ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value * 7

End If

Next j

Next i

End If

If Nedeli.Value = True Then

Exit Sub

End If

If Mes.Value = True Then

MsgBox "Точный перевод невозможен. Попробуйте другой вариант", vbCritical + vbOKOnly, "Ошибка ввода"

End If

If Godi.Value = True Then

MsgBox "Точный перевод невозможен. Попробуйте другой вариант", vbCritical + vbOKOnly, "Ошибка ввода"

End If

End If

If edin = 5 Then

If Minutes.Value = True Then

MsgBox "Точный перевод невозможен. Попробуйте другой вариант", vbCritical + vbOKOnly, "Ошибка ввода"

End If

If Chas.Value = True Then

MsgBox "Точный перевод невозможен. Попробуйте другой вариант", vbCritical + vbOKOnly, "Ошибка ввода"

End If

If Sutki.Value = True Then

MsgBox "Точный перевод невозможен. Попробуйте другой вариант", vbCritical + vbOKOnly, "Ошибка ввода"

End If

If Nedeli.Value = True Then

MsgBox "Точный перевод невозможен. Попробуйте другой вариант", vbCritical + vbOKOnly, "Ошибка ввода"

End If

If Mes.Value = True Then

Exit Sub

End If

If Godi.Value = True Then

For i = 2 To n + 1

For j = 2 To n + 1

If Not ActiveSheet.Cells(i, j).Value = "" Then

ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value / 12

End If

Next j

Next i

End If

End If

If edin = 6 Then

If Minutes.Value = True Then

For i = 2 To n + 1

For j = 2 To n + 1

If Not ActiveSheet.Cells(i, j).Value = "" Then

ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value * 525600

End If

Next j

Next i

End If

If Chas.Value = True Then

For i = 2 To n + 1

For j = 2 To n + 1

If Not ActiveSheet.Cells(i, j).Value = "" Then

ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value * 8760

End If

Next j

Next i

End If

If Sutki.Value = True Then

For i = 2 To n + 1

For j = 2 To n + 1

If Not ActiveSheet.Cells(i, j).Value = "" Then

ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value * 365

End If

Next j

Next i

End If

If Nedeli.Value = True Then

MsgBox "Точный перевод невозможен. Попробуйте другой вариант", vbCritical + vbOKOnly, "Ошибка ввода"

End If

If Mes.Value = True Then

For i = 2 To n + 1

For j = 2 To n + 1

If Not ActiveSheet.Cells(i, j).Value = "" Then

ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value * 12

End If

Next j

Next i

End If

If Godi.Value = True Then

Exit Sub

End If

End If

End If

 

If ActiveSheet.Cells(1, 1).Value = "Начальный этап" Then

If edin = 1 Then

If Minutes.Value = True Then

Exit Sub

End If

If Chas.Value = True Then

For i = 2 To scount

For j = 3 To 8

ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value / 60

Next j

Next i

End If

If Sutki.Value = True Then

For i = 2 To scount

For j = 3 To 8

If Not ActiveSheet.Cells(i, j).Value = "" Then

ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value / 1440

End If

Next j

Next i

End If

If Nedeli.Value = True Then

For i = 2 To scount

For j = 3 To 8

ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value / 10080

Next j

Next i

End If

If Mes.Value = True Then

MsgBox "Точный перевод невозможен. Попробуйте другой вариант", vbCritical + vbOKOnly, "Ошибка ввода"

End If

If Godi.Value = True Then

For i = 2 To scount

For j = 3 To 8

ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value / 525600

Next j

Next i

End If

End If

If edin = 2 Then

If Minutes.Value = True Then

For i = 2 To scount

For j = 3 To 8

ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value * 60

Next j

Next i

End If

If Chas.Value = True Then

Exit Sub

End If

If Sutki.Value = True Then

For i = 2 To scount

For j = 3 To 8

ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value / 24

Next j

Next i

End If

If Nedeli.Value = True Then

For i = 2 To scount

For j = 3 To 8

ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value / 168

Next j

Next i

End If

If Mes.Value = True Then

MsgBox "Точный перевод невозможен. Попробуйте другой вариант", vbCritical + vbOKOnly, "Ошибка ввода"

End If

If Godi.Value = True Then

For i = 2 To scount

For j = 3 To 8

ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value / 8760

Next j

Next i

End If

End If

If edin = 3 Then

If Minutes.Value = True Then

For i = 2 To scount

For j = 3 To 8

ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value * 1440

Next j

Next i

End If

If Chas.Value = True Then

For i = 2 To scount

For j = 3 To 8

ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value * 24

Next j

Next i

End If

If Sutki.Value = True Then

Exit Sub

End If

If Nedeli.Value = True Then

For i = 2 To scount

For j = 3 To 8

ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value / 7

Next j

Next i

End If

If Mes.Value = True Then

MsgBox "Точный перевод невозможен. Попробуйте другой вариант", vbCritical + vbOKOnly, "Ошибка ввода"

End If

If Godi.Value = True Then

For i = 2 To scount

For j = 3 To 8

ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value / 365

Next j

Next i

End If

End If

If edin = 4 Then

If Minutes.Value = True Then

For i = 2 To scount

For j = 3 To 8

ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value * 10080

Next j

Next i

End If

If Chas.Value = True Then

For i = 2 To scount

For j = 3 To 8

ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value * 168

Next j

Next i

End If

If Sutki.Value = True Then

For i = 2 To scount

For j = 3 To 8

ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value * 7

Next j

Next i

End If

If Nedeli.Value = True Then

Exit Sub

End If

If Mes.Value = True Then

MsgBox "Точный перевод невозможен. Попробуйте другой вариант", vbCritical + vbOKOnly, "Ошибка ввода"

End If

If Godi.Value = True Then

MsgBox "Точный перевод невозможен. Попробуйте другой вариант", vbCritical + vbOKOnly, "Ошибка ввода"

End If

End If

If edin = 5 Then

If Minutes.Value = True Then

MsgBox "Точный перевод невозможен. Попробуйте другой вариант", vbCritical + vbOKOnly, "Ошибка ввода"

End If

If Chas.Value = True Then

MsgBox "Точный перевод невозможен. Попробуйте другой вариант", vbCritical + vbOKOnly, "Ошибка ввода"

End If

If Sutki.Value = True Then

MsgBox "Точный перевод невозможен. Попробуйте другой вариант", vbCritical + vbOKOnly, "Ошибка ввода"

End If

If Nedeli.Value = True Then

MsgBox "Точный перевод невозможен. Попробуйте другой вариант", vbCritical + vbOKOnly, "Ошибка ввода"

End If

If Mes.Value = True Then

Exit Sub

End If

If Godi.Value = True Then

For i = 2 To scount

For j = 3 To 8

ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value / 12

Next j

Next i

End If

End If

If edin = 6 Then

If Minutes.Value = True Then

For i = 2 To scount

For j = 3 To 8

ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value * 525600

Next j

Next i

End If

If Chas.Value = True Then

For i = 2 To scount

For j = 3 To 8

ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value * 8760

Next j

Next i

End If

If Sutki.Value = True Then

For i = 2 To scount

For j = 3 To 8

ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value * 365

Next j

Next i

End If

If Nedeli.Value = True Then

MsgBox "Точный перевод невозможен. Попробуйте другой вариант", vbCritical + vbOKOnly, "Ошибка ввода"

End If

If Mes.Value = True Then

For i = 2 To scount

For j = 3 To 8

ActiveSheet.Cells(i, j).Value = ActiveSheet.Cells(i, j).Value * 12

Next j

Next i

End If

If Godi.Value = True Then

Exit Sub

End If

End If

End If

End Sub

 

Private Sub UserForm_Terminate()

Hide

SolForm.StartUpPosition = 0

SolForm.Top = 350

SolForm.Left = 480

SolForm.Show

End Sub

 

 

Форма SolForm (проверка правильности заполнения таблицы, проверка формата листа, проверка наличия данных в листе результатов, вызов модуля формирования и заполнения таблицы результатов)

 

Private Sub CommandButton1_Click()

Dim Ans As String

Dim fl As Boolean

Dim cou As Integer

cou = 0

check = True

If Not ActiveSheet.Cells(1, 1).Value = "№" Then

Ans = MsgBox("Лист не отформатирован для расчёта, воспользуйтесь окном ввода данных", vbCritical + vbOKCancel, "Ошибка")

If Ans = vbOK Then

Hide

InsForm.Show

Sheets("Data").Select

Exit Sub

End If

If Ans = vbCancel Then

Exit Sub

End If

End If

For i = 2 To n + 1

For j = 2 To n + 1

If Not IsNumeric(ActiveSheet.Cells(i, j).Value) Then

MsgBox "Длительность работы должна выражаться числом!", vbCritical + vbOKOnly, "Ошибка"

markcell

Exit Sub

End If

kn = ActiveSheet.Cells(i, j).Value

kk = Fix(ActiveSheet.Cells(i, j).Value)

If kk < kn Then

MsgBox "Дробные числа дают погрешность при вычислении! Воспользуйтесь переводом единиц времени, чтобы получить целые числа.", vbCritical + vbOKOnly, "Ошибка"

markcell

Exit Sub

End If

If Not ActiveSheet.Cells(i, j).Value = "" Then

If Not ActiveSheet.Cells(j, i).Value = "" Then

MsgBox "Есть этапы, которые замыкаются сами на себя! Это приведёт к зацикливанию программы!", vbCritical + vbOKOnly, "Ошибка"

markcell

Exit Sub

End If

End If

Next j

If Not ActiveSheet.Cells(i, i).Value = "" Then

j = i

MsgBox "Точка отсчёта не должна имееть длительности", vbCritical + vbOKOnly, "Ошибка"

markcell

Exit Sub

End If

Next i

For i = 2 To n + 1

fl = False

For j = 2 To n + 1

If Not ActiveSheet.Cells(j, i).Value = "" Then

fl = True

End If

Next j

If fl = True Then

cou = cou + 1

End If

Next i

If cou = n Then

MsgBox "Должен быть хотя бы один начальный этап!", vbCritical + vbOKOnly, "Ошибка"

Exit Sub

End If

If cou = 0 Then

MsgBox "Должен быть хотя бы один конечный этап!", vbCritical + vbOKOnly, "Ошибка"

Exit Sub

End If

If hlp = True Then

Hide

HelpForm2.Show

End If

If check = False Then

Exit Sub

End If

Application.ScreenUpdating = False

Sheets("Rez").Select

If Sheets("Rez").Cells(1, 1).Value = "Начальный этап" Then

Ans = MsgBox("Лист Rez уже содержит результаты вычислений. Сохранить вычисления в другом листе?", vbCritical + vbYesNo, "Информация")

If Ans = vbYes Then

Sheets.Add

For i = 1 To 222

For j = 1 To 8

ActiveSheet.Cells(i, j).Value = Sheets("Rez").Cells(i, j).Value

Next j

Next i

RTable

End If

End If

Sheets("Rez").Select

Range("A1:IV230").Select

Selection.Clear

RTable

Sheets("Data").Select

Solut

Application.ScreenUpdating = True

Sheets("Rez").Select

End Sub

 

Private Sub CommandButton2_Click()

Hide

InsForm.Start

InsForm.Show

Sheets("Data").Select

End Sub

 

Private Sub CommandButton6_Click()

check = True

If Not ActiveSheet.Cells(1, 1).Value = "№" Then

If Not ActiveSheet.Cells(1, 1).Value = "Начальный этап" Then

MsgBox "Лист не отформатирован для расчёта, воспользуйтесь окном ввода данных", vbCritical + vbOKOnly, "Ошибка"

Hide

InsForm.Show

Sheets("Data").Select

Exit Sub

End If

End If

If hlp = True Then

Hide

HelpForm3.Show

End If

If check = False Then

Exit Sub

End If

Hide

Perevod1.Show

End Sub

 

Private Sub UserForm_Terminate()

Hide

STF.Show

End Sub