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
Форма STF (вход в программу, завершение работы приложения)
Private Sub CommandButton1_Click()
Hide
InsForm.Show
Sheets("Data").Select
End Sub
Private Sub CommandButton2_Click()
Answer = MsgBox("Вы действительно хотите завершить работу?", vbYesNo + vbQuestion + vbDefaultButton2, "Завершение работы")
If Answer = vbYes Then
ThisWorkbook.Saved = True
Application.Quit
End If
End Sub
Private Sub UserForm_Initialize()
STF.Height = Application.Height
STF.Width = Application.Width
'STF.CommandButton1.Left = STF.Width / 4 - 36
'STF.CommandButton1.Top = STF.Top + 15
'STF.CommandButton2.Left = STF.Width / 2 - 10
'STF.CommandButton2.Top = STF.Top + 15
End Sub
Private Sub UserForm_Terminate()
Answer = MsgBox("Вы действительно хотите завершить работу?", vbYesNo + vbQuestion + vbDefaultButton2, "Завершение работы")