Dim s500, s510, s730, s735, s740, tekaktiv, tekpassiv As Double
Расчёт частного от значений 1-го и 2-го текстовых полей:
Private Sub Command1_Click()
Text3.Text = ""
a = 0
b = 0
c = 0
If Text1.Text = "" Then GoTo M
If Text2.Text = "" Then GoTo M
If Text2.Text = 0 Then Text3.Text = "На ноль делить нельзя!!!"
If Text2.Text = 0 Then GoTo M
a = Text1.Text
b = Text2.Text
c = a / b
Text3.Text = c
M:
Text1.SetFocus
End Sub
Очистка формы от всех результатов:
Private Sub Command2_Click()
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Label1.Caption = "Показатель"
Label4.Caption = ""
Label5.Caption = ""
Label6.Caption = ""
Label7.Caption = ""
Label8.Caption = ""
Label9.Caption = ""
Label10.Caption = ""
Label11.Caption = ""
Label13.Caption = ""
Label15.Caption = ""
Label17.Caption = ""
Label18.Caption = ""
Label19.Caption = ""
Label20.Caption = ""
Label21.Caption = ""
Label22.Caption = ""
Fotd = 0
Oos = 0
Oobakt = 0
Ozap = 0
Odz = 0
Oba = 0
Oksk = 0
a = 0
b = 0
c = 0
d = 0
x = 0
y = 0
z = 0
Kteklik = 0
Kobes = 0
Rob = 0
Rchist = 0
Command6.Enabled = False
Text1.SetFocus
End Sub
Нахождение значения текущего актива:
Private Sub Command3_Click()
a = InputBox("Итог раздела II актива баланса", "Текущий актив")
b = InputBox("Итог раздела III актива баланса")
If a = "" Then a = 0
If b = "" Then b = 0
tekaktiv = -(-a - b)
Label13.Caption = tekaktiv
End Sub
Нахождение значения текущих обязательств:
Private Sub Command4_Click()
c = InputBox("Итог раздела II пассива баланса", "Краткосрочные обязательства")
s500 = InputBox("Строка 500 раздела II пассива баланса", "Краткосрочные обязательства")
s510 = InputBox("Строка 510 раздела II пассива баланса", "Краткосрочные обязательства")
s730 = InputBox("Строка 730 раздела II пассива баланса", "Краткосрочные обязательства")
s735 = InputBox("Строка 735 раздела II пассива баланса", "Краткосрочные обязательства")
s740 = InputBox("Строка 740 раздела II пассива баланса", "Краткосрочные обязательства")
If c = "" Then c = 0
If s500 = "" Then s500 = 0
If s510 = "" Then s510 = 0
If s730 = "" Then s730 = 0
If s740 = "" Then s740 = 0
If s735 = "" Then s735 = 0
tekpassiv = c - s500 - s510 - s730 - s735 - s740
Label15.Caption = tekpassiv
If tekpassiv = 0 Then MsgBox ("Возможно допущена ошибка!")
End Sub
Нахождение значения собственных оборотных средств:
Private Sub Command5_Click()
a = InputBox("Итог раздела I пассива баланса", "Собственные оборотные средства")
b = InputBox("Итог раздела I актива баланса", "Собственные оборотные средства")
If a = "" Then a = 0
If b = "" Then b = 0
tekaktiv = a - b
Label17.Caption = tekaktiv
End Sub
Пересчёт коэффициентов оборачиваемости в периоды оборотов (в днях)
Private Sub Command6_Click()
If Fotd = 0 Then GoTo M:
a = 365 / Int(Fotd)
Label10.Caption = Int(a)
M:
If Oos = 0 Then GoTo N:
b = 365 / Int(Oos)
Label11.Caption = Int(b)
N:
If Oobakt = 0 Then GoTo V:
c = 365 / Int(Oobakt)
Label18.Caption = Int(c)
V:
If Ozap = 0 Then GoTo F:
d = 365 / Int(Ozap)
Label19.Caption = Int(d)
F:
If Odz = 0 Then GoTo H:
x = 365 / Int(Odz)
Label20.Caption = Int(x)
H:
If Oba = 0 Then GoTo P:
y = 365 / Int(Oba)
Label21.Caption = Int(y)
P:
If Oksk = 0 Then GoTo I:
z = 365 / Int(Oksk)
Label22.Caption = Int(z)
I:
End Sub
Завершение работы приложения:
Private Sub Exit_Click()
End
End Sub
Расчёт общей капиталоотдачи (фондоотдачи):
Private Sub Fo_Click()
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Label1.Caption = "Общая капиталоотдача (Фондоотдача)"
Text1.Text = InputBox("Продукция (оборот) ", "Фондоотдача")
Text2.Text = InputBox("Средняя стоимость имущества", "Фондоотдача")
If Text1.Text = "" Then GoTo M
If Text2.Text = "" Then GoTo M
a = Text1.Text
b = Text2.Text
Fotd = (a / b)
Label10.Caption = Fotd
Text3.Text = Fotd
Command6.Enabled = True
M:
Text1.SetFocus
End Sub
Расчёт коэффициента обеспеченности собственными средствами:
Private Sub Ko_Click()
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Label1.Caption = "К обеспеченности собственными средствами"
Text1.Text = InputBox("Собственные оборотные средства", "Ко")
Text2.Text = InputBox("Текущие активы", "Ко")
If Text1.Text = "" Then GoTo M
If Text2.Text = "" Then GoTo M
a = Text1.Text
b = Text2.Text
Kobes = a / b
Label5.Caption = Kobes
Text3.Text = Kobes
If Kobes > 0.1 Then Label5.ForeColor = &HC000&
If Kobes < 0.1 Then MsgBox ("Неудовлетворительная структура баланса!!!")
If Kobes < 0.1 Then Label5.ForeColor = &HFF&
If Kobes < 0.1 Then Kvosstplatezhsti.Enabled = True
M:
Text1.SetFocus
End Sub
Расчёт коэффициента текущей ликвидности:
Private Sub Ktl_Click()
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Label1.Caption = "К текущей ликвидности"
Text1.Text = InputBox("Текущие активы", "Ктл")
Text2.Text = InputBox("Краткосрочные пассивы (Наиболее срочные обязательства)", "Ктл")
If Text1.Text = "" Then GoTo M
If Text2.Text = "" Then GoTo M
a = Text1.Text
b = Text2.Text
Kteklik = a / b
Label4.Caption = Kteklik
Text3.Text = Kteklik
If Kteklik > 2 Then Label4.ForeColor = &HC000&
If Kteklik < 2 Then MsgBox ("Неудовлетворительная структура баланса!!! Предприятие не платёжеспособно!")
If Kteklik < 2 Then Label4.ForeColor = &HFF&
If Kteklik < 2 Then Kvosstplatezhsti.Enabled = True
Kutrplatezhsti.Enabled = True
M:
Text1.SetFocus
End Sub
Расчёт коэффициента утраты платёжеспособности:
Private Sub Kutrplatezhsti_Click()
a = InputBox("Введите коэффициент текущей ликвидности на начало года", "Ктлнг")
If a = "" Then GoTo M:
c = (Kteklik + 3 / 12 * (Kteklik - a)) / 2
Label7.Caption = c
If c < 1 Then MsgBox ("Предприятие в ближайшее время может утратить платежеспособность")
If c > 1 Then MsgBox ("У предприятия нет тенденции к утрате платежеспособности")
If c < 1 Then Label7.ForeColor = &HFF&
If c > 1 Then Label7.ForeColor = &HC000&
M:
Text1.SetFocus
End Sub
Расчёт коэффициента восстановления платёжеспособности:
Private Sub Kvosstplatezhsti_Click()
a = InputBox("Введите коэффициент текущей ликвидности на начало года", "Ктлнг")
If a = "" Then GoTo M:
c = (Kteklik + 6 / 12 * (Kteklik - a)) / 2
Label6.Caption = c
If c < 1 Then MsgBox ("У предприятия в ближайшее время нет реальной возможности восстановить платежеспособность")
If c < 1 Then Label6.ForeColor = &HFF&
If c > 1 Then MsgBox ("Предприятие в ближайшее время может восстановить платежеспособность")
If c > 1 Then Label6.ForeColor = &HC000&
M:
Text1.SetFocus
End Sub
Расчёт оборачиваемости банковских активов:
Private Sub Obankaktiv_Click()
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Label1.Caption = "Оборачиваемость банковских активов"
Text1.Text = InputBox("Продукция (оборот)", "Оборачиваемость банковских активов")
Text2.Text = InputBox("Средняя величина свободных денежных средств и ценных бумаг", "Оборачиваемость банковских активов")
If Text1.Text = "" Then GoTo M
If Text2.Text = "" Then GoTo M
a = Text1.Text
b = Text2.Text
Oba = (a / b)
Label21.Caption = Oba
Text3.Text = Oba
Command6.Enabled = True
M:
Text1.SetFocus
End Sub
Расчёт оборачиваемости дебиторской задолженности:
Private Sub Odebitzad_Click()
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Label1.Caption = "Оборачиваемость дебиторской задолженности"
Text1.Text = InputBox("Продукция (оборот)", "Оборачиваемость дебиторской задолженности")
Text2.Text = InputBox("Средняя величина дебиторской задолженности", "Оборачиваемость дебиторской задолженности")
If Text1.Text = "" Then GoTo M
If Text2.Text = "" Then GoTo M
a = Text1.Text
b = Text2.Text
Odz = (a / b)
Label20.Caption = Odz
Text3.Text = Odz
Command6.Enabled = True
M:
Text1.SetFocus
End Sub
Расчёт оборачиваемости собственного капитала:
Private Sub Oksobstvkapit_Click()
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Label1.Caption = "Оборот к собственному капиталу"
Text1.Text = InputBox("Продукция (оборот)", "Оборот к собственному капиталу")
Text2.Text = InputBox("Средняя величина собственного капитала", "Оборот к собственному капиталу")
If Text1.Text = "" Then GoTo M
If Text2.Text = "" Then GoTo M
a = Text1.Text
b = Text2.Text
Oksk = (a / b)
Label22.Caption = Oksk
Text3.Text = Oksk
Command6.Enabled = True
M:
Text1.SetFocus
End Sub
Расчёт оборачиваемости всех оборотных активов:
Private Sub Oobak_Click()
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Label1.Caption = "Оборачиваемость всех оборотных активов"
Text1.Text = InputBox("Продукция (оборот)", "Оборачиваемость всех оборотных активов")
Text2.Text = InputBox("Средняя стоимость оборотных активов", "Оборачиваемость всех оборотных активов")
If Text1.Text = "" Then GoTo M
If Text2.Text = "" Then GoTo M
a = Text1.Text
b = Text2.Text
Oobakt = (a / b)
Label18.Caption = Oobakt
Text3.Text = Oobakt
Command6.Enabled = True
M:
Text1.SetFocus
End Sub
Расчёт отдачи основных средств и нематериальных активов:
Private Sub Oosnsr_Click()
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Label1.Caption = "Отдача ос и нематериальных активов"
Text1.Text = InputBox("Продукция (оборот)", "Отдача ос и нематериальных активов")
Text2.Text = InputBox("Средняя стоимость ос и нематериальных активов", "Отдача ос и нематериальных активов")
If Text1.Text = "" Then GoTo M
If Text2.Text = "" Then GoTo M
a = Text1.Text
b = Text2.Text
Oos = (a / b)
Label11.Caption = Oos
Text3.Text = Oos
Command6.Enabled = True
M:
Text1.SetFocus
End Sub
Расчёт оборачиваемости запасов:
Private Sub Ozapasov_Click()
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Label1.Caption = "Оборачиваемость запасов"
Text1.Text = InputBox("Продукция (оборот)", "Оборачиваемость запасов")
Text2.Text = InputBox("Средняя стоимость запасов", "Оборачиваемость запасов")
If Text1.Text = "" Then GoTo M
If Text2.Text = "" Then GoTo M
a = Text1.Text
b = Text2.Text
Ozap = (a / b)
Label19.Caption = Ozap
Text3.Text = Ozap
Command6.Enabled = True
M:
Text1.SetFocus
End Sub
Расчёт показателя рентабельности производства:
Private Sub Rproizv_Click()
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Label1.Caption = "Рентабельность производства"
Text1.Text = InputBox("Прибыль", "Рентабельность производства")
Text2.Text = InputBox("Себестоимость продукции", "Рентабельность производства")
If Text1.Text = "" Then GoTo M
If Text2.Text = "" Then GoTo M
a = Text1.Text
b = Text2.Text
Rproiz = (a / b)
Label9.Caption = Rproiz
Text3.Text = Rproiz
If Rproiz > 0.12 Then Label9.ForeColor = &HC000&
If Rproiz < 0.12 Then Label9.ForeColor = &HFF&
If Rproiz < 0.12 Then MsgBox ("Рентабельность производства меньше нормы(0,12)")
M:
Text1.SetFocus
End Sub
Расчёт показателя рентабельности продаж:
Private Sub Rprodaj_Click()
Text1.Text = ""
Text2.Text = ""