Банк как субъект привлечения иностранных инвестиций в регион
Страница 13
i = i + 1
End If
End If
If Mag(3) < 0 Then
If Mag(1) < 0 Then
If MemoOrder(i; min(Mag(3); Mag(1)); SR970; S192; 0; _
"Отрицательная разница от продажи РКО за " + CStr(CurDate)) Then Exit Sub
i = i + 1
End If
If Mag(2) < 0 Then
If MemoOrder(i; min(Mag(3); Mag(2)); SR970; S904; 0; _
"Отрицательная разница от продажи РКО за " + CStr(CurDate)) Then Exit Sub
i = i + 1
End If
End If
If Format(Mag(4)) > 0 Then
If MemoOrder(i; Mag(4); S970; S904; 0; _
"Комиссия ВКБ в т.ч. НДС " + CStr(Format(Mag(4) / 6; "0,00"))) Then Exit Sub
End If
End Sub
'-------------------------------------------- Memo Order
Function MemoOrder(Num; sum As Double; n1; n2; Pos As Integer; Order As String)
Dim i As Integer
Dim Flag As Boolean
Dim Str; Str1 As String
Str1 = ""
Str = CStr(sum)
Str = Format(Str; "000000000000,00")
Flag = False
For i = 1 To Len(Str)
If Mid(Str; i; 1) = "," Then
If CInt(Right(Str; 2)) = 0 Then
Str1 = Str1 + "="
Exit For
Else
Str1 = Str1 + "-"
End If
Else
If Mid(Str; i; 1) <> "0" Then Flag = True
If Mid(Str; i; 1) <> "0" Or Flag Then Str1 = Str1 + Mid(Str; i; 1)
End If
Next i
Cells(3; 6) = Str1
If Pos > 0 Then
If n1 > 6 Then
Cells(5; 6) = Worksheets("Клиенты").Cells(2; n1)
Else
Cells(5; 6) = Worksheets("Клиенты").Cells(Pos; n1)
End If
If n2 > 6 Then
Cells(10; 6) = Worksheets("Клиенты").Cells(2; n2)
Else
Cells(10; 6) = Worksheets("Клиенты").Cells(Pos; n2)
End If
Else
Cells(5; 6) = n1
Cells(10; 6) = n2
End If
Cells(16; 1) = Order
Cells(1; 6) = Num
Range("A1:H24").Copy
Range("A32").Select
ActiveSheet.Paste
If DialogPrint("Ордер"; 2) Then
MemoOrder = True
Else
MemoOrder = False
End If
End Function
'-------------------------------- Печать биржевой информации -------
Sub PrintBirgaInfo()
Dim Sheet As Object
Dim Flag As Boolean
Dim i; n; k; Num As Long
Dim mas(3) As Double
Set Sheet = Worksheets("Биржа")
CurDate = Worksheets("Врем").Cells(1; 4)
Sheets("Биржевая Информация").Select
Cells(3; 10) = CurDate
For i = 1 To 3
mas(i) = 0
Next i
i = 2
n = 7
Range(Cells(n; 1); Cells(n + 100; 17)).Delete shift:=xlToLeft
Flag = True
Do While Sheet.Cells(i; 1) <> Empty
If Sheet.Cells(i; 1) = CurDate Then
Flag = False
Cells(n; 1) = Sheet.Cells(i; 2)
Cells(n; 7) = Sheet.Cells(i; 3)
Cells(n; 9) = Sheet.Cells(i; 4)
Cells(n; 10) = Sheet.Cells(i; 5)
Cells(n; 5).Font.Bold = True
Cells(n; 11) = Sheet.Cells(i; 6)
Cells(n; 11).Font.Bold = True
Cells(n; 12) = Sheet.Cells(i; 7)
Cells(n; 13) = Sheet.Cells(i; 8)
k = 2
While Worksheets("Бумаги").Cells(k; 1) <> Empty
If Worksheets("Бумаги").Cells(k; 1) = Cells(n; 1) Then
Cells(n; 2) = Worksheets("Бумаги").Cells(k; 2)
Cells(n; 3) = Worksheets("Бумаги").Cells(k; 3)
Cells(n; 6) = Worksheets("Бумаги").Cells(k; 4)
End If
k = k + 1
Wend
Cells(n; 2).NumberFormat = "ДД.ММ.ГГ"
Cells(n; 3).NumberFormat = "ДД.ММ.ГГ"
Cells(n; 6).NumberFormat = "# ##0"
Cells(n; 9).NumberFormat = "# ##0"
Range(Cells(n; 10); Cells(n; 17)).NumberFormat = "0,00"
Cells(n; 4) = Cells(3; 10) - Cells(n; 2)
Cells(n; 5) = Cells(n; 3) - Cells(3; 10)
Cells(n; 8) = Cells(n; 9) / Cells(n; 6) * 100
Cells(n; 8).NumberFormat = "0,00"
If Cells(n; 7) <> 0 And Cells(n; 5) <> 0 Then
Cells(n; 14) = (100 / Cells(n; 10) - 1) * 36500 / Cells(n; 5) * 0,85
Cells(n; 15) = (100 / Cells(n; 10) - 1) * 36500 / Cells(n; 5)
Cells(n; 16) = (100 / Cells(n; 11) - 1) * 36500 / Cells(n; 5) * 0,85
Cells(n; 16).Font.Bold = True
Cells(n; 17) = (100 / Cells(n; 11) - 1) * 36500 / Cells(n; 5)
mas(1) = mas(1) + Cells(n; 5) * Cells(n; 9) * Cells(n; 14)
mas(2) = mas(2) + Cells(n; 5) * Cells(n; 9) * Cells(n; 16)
mas(3) = mas(3) + Cells(n; 5) * Cells(n; 9)
End If
n = n + 1
End If
i = i + 1
Loop
If Flag Then
MsgBox "Биржевой информации нет"
Exit Sub
End If
Num = n
Range(Cells(7; 1); Cells(Num - 1; 17)).Borders(xlLeft).Weight = xlThin
Range(Cells(7; 1); Cells(Num - 1; 17)).Borders(xlRight).Weight = xlThin
Range(Cells(7; 1); Cells(Num - 1; 17)).Borders(xlTop).Weight = xlThin
Range(Cells(7; 1); Cells(Num - 1; 17)).Borders(xlBottom).Weight = xlThin
Range(Cells(7; 1); Cells(Num - 1; 17)).BorderAround Weight:=xlMedium
Cells(Num; 1) = "Итого"
Cells(Num; 1).Font.Bold = True
Cells(Num; 1).HorizontalAlignment = xlCenter
Cells(Num; 14) = mas(1) / mas(3)
Cells(Num; 15) = mas(1) / mas(3) / 0,85
Cells(Num; 16) = mas(2) / mas(3)
Cells(Num; 16).Font.Bold = True
Cells(Num; 17) = mas(2) / mas(3) / 0,85
Range(Cells(Num; 14); Cells(Num; 17)).NumberFormat = "0,00"
For i = 1 To 3
mas(i) = 0
Next i
For i = 7 To Num - 1
mas(1) = mas(1) + Cells(i; 6)
mas(2) = mas(2) + Cells(i; 7)
mas(3) = mas(3) + Cells(i; 9)
Next
Cells(Num; 6) = mas(1)
Cells(Num; 6).NumberFormat = "# ##0"
Cells(Num; 7) = mas(2)
Cells(Num; 9) = mas(3)
Cells(Num; 9).NumberFormat = "# ##0"
Cells(Num; 8) = mas(3) / mas(1) * 100
Cells(Num; 8).NumberFormat = "0,00"
Cells(Num; 7).Font.Bold = True
Cells(Num; 9).Font.Bold = True
Range(Cells(Num; 1); Cells(Num; 17)).BorderAround Weight:=xlMedium
Range(Cells(Num; 1); Cells(Num; 17)).Interior.ColorIndex = 15
If DialogPrint("Биржевая Информация"; 1) Then Exit Sub
End Sub
'-------------------------------- Дата -----------------------------
Sub DateChange()
With DialogSheets("ДиалогДата")
.EditBoxes.Text = CurDate
.EditBoxes.InputType = 1
.Show
CurDate = Worksheets("Врем").Cells(1; 4)
If Button = False Then
CurDate = Date
Worksheets("Врем").Cells(1; 4) = CurDate
MsgBox "Дата восстановлена"
Else
If IsDate(.EditBoxes.Text) Then
CurDate = .EditBoxes.Text
MsgBox "Дата изменена"
Worksheets("Врем").Cells(1; 4) = CurDate
Exit Sub
End If
MsgBox "Ошибка при вводе даты"
End If
End With
End Sub
'-------------------------------- Формирование текущей таблицы бумаг ----
Sub FormBum()
Dim L As Object
Dim i; k As Integer
Set L = Worksheets("Бумаги")
CurDate = Worksheets("Врем").Cells(1; 4)
i = 2
k = 1
While L.Cells(i; 1) <> Empty
If L.Cells(i; 2) <= CurDate And L.Cells(i; 3) >= CurDate Then
Worksheets("Врем").Cells(k; 1) = L.Cells(i; 1)
k = k + 1
End If
i = i + 1
Wend
Worksheets("Врем").Cells(1; 2) = k - 1
Set L = Worksheets("Клиенты")
i = 1
While L.Cells(i; 1) <> Empty
i = i + 1
Wend
Worksheets("Врем").Cells(1; 3) = i - 2
End Sub
' ------------------------------- Остатки на бирже --------------------
Sub EditOstBirga(CliNum As Long)
Dim ComBirga; sum; OstBegin As Double
Dim DoFlag As Boolean
Dim Sheet; Sheet1 As Object
Dim i; k; RowNum As Long
Set Sheet = Worksheets("ОстаткиБиржа")
Set Sheet1 = Worksheets("Сделки")
CurDate = Worksheets("Врем").Cells(1; 4)
ComBirga = Worksheets("Инфо").Cells(1; 2)