Банк как субъект привлечения иностранных инвестиций в регион
Страница 11
Wend
i = 2
Set Sheet = Worksheets("Биржа")
Flag = True
While Sheet.Cells(i; 1) <> Empty
If Sheet.Cells(i; 1) = CurDate Then
Flag = False
For k = 1 To BumNum
If Sheet.Cells(i; 2) = Bum(k) Then
If Sheet.Cells(i; 6) > 0 Then
BumPrice(k) = Sheet.Cells(i; 6)
Else
BumPrice(k) = 0
End If
End If
Next k
End If
i = i + 1
Wend
If Flag Then
MsgBox "Биржевой информации нет. Портфель сформировать невозможно."
Exit Sub
End If
Worksheets("Портфель1").Select
Cells(4; 3) = CurDate
Range("A7:H200").Delete shift:=xlToLeft
m = 7
PortfelCost = 0
PortfelBalance = 0
For k = 1 To BumNum
If Volume(k; BeginIndex(k)) > 0 Then
For i = BeginIndex(k) To dates(k)
If Volume(k; i) > 0 Then
Cells(m; 1) = Bum(k)
Cells(m; 1).NumberFormat = "0"
Cells(m; 2) = DateMas(k; i)
Cells(m; 2).NumberFormat = "ДД.ММ.ГГ"
Cells(m; 3) = Price(k; i)
Cells(m; 3).NumberFormat = "0,00"
Cells(m; 4) = Volume(k; i)
Cells(m; 4).NumberFormat = "0"
DohPog(k; i) = (100 / Price(k; i) - 1) * 36500 / (DatePog(k) - DateMas(k; i))
Cells(m; 5) = DohPog(k; i)
Cells(m; 5).NumberFormat = "0,00"
Cells(m; 8).NumberFormat = "0"
Dim tmp As Long
tmp = CurDate - DateMas(k; i)
Cells(m; 8) = tmp
PortfelBalance = PortfelBalance + Price(k; i) * Volume(k; i)
If BumPrice(k) > 0 Then
PortfelCost = PortfelCost + BumPrice(k) * Volume(k; i)
Else
PortfelCost = PortfelCost + Price(k; i) * Volume(k; i)
End If
If BumPrice(k) > 0 Then
Cells(m; 6) = BumPrice(k)
Cells(m; 6).NumberFormat = "0,00"
If CurDate <> DateMas(k; i) Then
DohPriobr(k; i) = (BumPrice(k) / Price(k; i) - 1) * 36500 / (CurDate - DateMas(k; i))
Cells(m; 7) = DohPriobr(k; i)
Cells(m; 7).NumberFormat = "0,00"
End If
End If
m = m + 1
End If
Next i
Range(Cells(m; 1); Cells(m; 8)).Interior.ColorIndex = 15
m = m + 1
End If
Next k
Range(Cells(7; 1); Cells(m - 1; 8)).Borders(xlLeft).Weight = xlThin
Range(Cells(7; 1); Cells(m - 1; 8)).Borders(xlRight).Weight = xlThin
Range(Cells(7; 1); Cells(m - 1; 8)).Borders(xlTop).Weight = xlThin
Range(Cells(7; 1); Cells(m - 1; 8)).Borders(xlBottom).Weight = xlThin
Range(Cells(7; 1); Cells(m - 1; 8)).BorderAround Weight:=xlMedium
If DialogPrint("Портфель1"; 1) Then Exit Sub
Worksheets("Портфель2").Select
Cells(4; 3) = CurDate
SumPog11 = 0
SumPog22 = 0
SumPriobr11 = 0
SumPriobr22 = 0
AllVol = 0
m = 7
Range("A7:H200").Delete shift:=xlToLeft
For k = 1 To BumNum
If Volume(k; BeginIndex(k)) > 0 Then
SumPog1(k) = 0
SumPog2(k) = 0
SumPriobr1(k) = 0
SumPriobr2(k) = 0
BumVol(k) = 0
For i = BeginIndex(k) To dates(k)
If Volume(k; i) > 0 Then
SumPog1(k) = SumPog1(k) + DohPog(k; i) * Volume(k; i) * (DatePog(k) - DateMas(k; i))
SumPog2(k) = SumPog2(k) + Volume(k; i) * (DatePog(k) - DateMas(k; i))
If CurDate <> DateMas(k; i) Then
SumPriobr1(k) = SumPriobr1(k) + DohPriobr(k; i) * Volume(k; i) * (CurDate - DateMas(k; i))
SumPriobr2(k) = SumPriobr2(k) + Volume(k; i) * (CurDate - DateMas(k; i))
End If
SumPog11 = SumPog11 + SumPog1(k)
SumPog22 = SumPog22 + SumPog2(k)
SumPriobr11 = SumPriobr11 + SumPriobr1(k)
SumPriobr22 = SumPriobr22 + SumPriobr2(k)
BumVol(k) = BumVol(k) + Volume(k; i)
AllVol = AllVol + Volume(k; i)
End If
Next i
Cells(m; 1) = Bum(k)
Cells(m; 1).NumberFormat = "0"
Cells(m; 2) = BumVol(k)
Cells(m; 2).NumberFormat = "0"
Cells(m; 3) = SumPog1(k) / SumPog2(k)
Cells(m; 3).NumberFormat = "0,00"
If SumPriobr2(k) > 0 And SumPriobr1(k) > 0 Then
Cells(m; 4) = SumPriobr1(k) / SumPriobr2(k)
Cells(m; 4).NumberFormat = "0,00"
End If
m = m + 1
End If
Next k
Cells(m; 1) = "Итого"
Cells(m; 1).Font.Bold = True
Cells(m; 1).HorizontalAlignment = xlCenter
Cells(m; 2) = AllVol
Cells(m; 2).NumberFormat = "0"
Cells(m; 3) = SumPog11 / SumPog22
Cells(m; 3).NumberFormat = "0,00"
Cells(m; 4) = SumPriobr11 / SumPriobr22
Cells(m; 4).NumberFormat = "0,00"
Range(Cells(m; 1); Cells(m; 4)).Interior.ColorIndex = 15
Range(Cells(7; 1); Cells(m; 4)).Borders(xlLeft).Weight = xlThin
Range(Cells(7; 1); Cells(m; 4)).Borders(xlRight).Weight = xlThin
Range(Cells(7; 1); Cells(m; 4)).Borders(xlTop).Weight = xlThin
Range(Cells(7; 1); Cells(m; 4)).Borders(xlBottom).Weight = xlThin
Range(Cells(7; 1); Cells(m; 4)).BorderAround Weight:=xlMedium
Range(Cells(m; 1); Cells(m; 4)).BorderAround Weight:=xlMedium
Cells(m + 1; 1) = "Стоимость портфеля по балансу"
Cells(m + 2; 1) = "Текущая стоимость потфеля"
Cells(m + 1; 1).Font.Bold = True
Cells(m + 2; 1).Font.Bold = True
Range(Cells(m + 1; 1); Cells(m + 2; 4)).BorderAround Weight:=xlMedium
Cells(m + 1; 4) = PortfelBalance * 10
Cells(m + 1; 4).NumberFormat = "### ### ###,00"
Cells(m + 1; 4).Font.Bold = True
Cells(m + 2; 4) = PortfelCost * 10
Cells(m + 2; 4).NumberFormat = "### ### ###,00"
Cells(m + 2; 4).Font.Bold = True
If DialogPrint("Портфель2"; 1) Then Exit Sub
End Sub
'-------------------------------- Печать Журнала лицевого учета ---------
Sub PrintMagazine()
Dim Sheet As Object
Dim i; k; BumNum; m; m1; j As Long
Dim Bum(ConstMaxBum) As Long
Dim Volume(); BiginIndex(); dates(); V(); Vol As Integer
Dim sum; Price() As Double
Dim DateMas() As Date
Dim Flag; BumIndex() As Boolean
Dim ComBirga; ComMas(); MagMas(); Mag(4) As Double
CurDate = Worksheets("Врем").Cells(1; 4)
i = 2
Flag = True
Do While Worksheets("Сделки").Cells(i; 1) <> Empty
If Worksheets("Сделки").Cells(i; 1) = CurDate And _
Worksheets("Сделки").Cells(i; 2) = DilerConst Then
Flag = False
Exit Do
End If
i = i + 1
Loop
If Flag Then
MsgBox "Сделок в текущий день не было"
Exit Sub
End If
Set Sheet = Worksheets("Бумаги")
i = 2
BumNum = 0
While Sheet.Cells(i; 1) <> Empty
If (Sheet.Cells(i; 2) <= CurDate And Sheet.Cells(i; 3) >= CurDate) Then
Bum(BumNum + 1) = Sheet.Cells(i; 1)
BumNum = BumNum + 1
End If
i = i + 1
Wend
Worksheets("Сделки").Select
Range("B2").Sort Key1:=Range("A2"); Order1:=xlAscending; _
Key2:=Range("D2"); Order2:=xlAscending; _
Header:=xlYes; OrderCustom:=1; _
MatchCase:=False; Orientation:=xlTopToBottom
ReDim Volume(BumNum; MaxCount)
ReDim Price(BumNum; MaxCount)
ReDim DateMas(BumNum; MaxCount)
ReDim dates(BumNum); V(BumNum); BeginIndex(BumNum)
ReDim BumIndex(BumNum); ComMas(BumNum)
ReDim MagMas(BumNum; 4)
For i = 1 To BumNum
ComMas(i) = 0
dates(i) = 1
Next i
i = 2
While Cells(i; 1) <> Empty And CurDate > Cells(i; 1)
If Cells(i; 2) = DilerConst And Cells(i; 7) <> "списание" _
And Cells(i; 7) <> "зачисление" Then
Flag = True
For k = 1 To BumNum ' поиск номера бумаги
If Cells(i; 3) = Bum(k) Then
Flag = False
Exit For
End If
Next k
If Flag Then GoTo cont
If Not IsEmpty(Cells(i; 4)) Then
Volume(k; dates(k)) = Cells(i; 6)
Price(k; dates(k)) = Cells(i; 4)
DateMas(k; dates(k)) = Cells(i; 1)
dates(k) = dates(k) + 1
V(k) = V(k) + Cells(i; 6)