End If
If ExitVar Then Exit Sub
If Button Then ActiveWindow.SelectedSheets.PrintOut copies:=2
End With
End Sub
'-------------------------------- Перечисление/списание биржа ------
Sub GotoBirga()
Dim Sheet As Object
Dim OstIn; OstOut; OstBegin; CliNum As Double
Dim RowNum; k As Long
Dim DoFlag As Boolean
Set Sheet = Worksheets("ОстаткиБиржа")
Sheet.Range("B2").Sort Key1:=Sheet.Range("B2"); Order1:=xlAscending; _
Key2:=Sheet.Range("A2"); Order2:=xlDescending; _
Header:=xlYes; OrderCustom:=1; _
MatchCase:=False; Orientation:=xlTopToBottom
Sheet.Select
CurDate = Worksheets("Врем").Cells(1; 4)
k = 2
While Worksheets("Клиенты").Cells(k; 1) <> Empty
k = k + 1
Wend
With DialogSheets("ДиалогБиржа")
.DropDowns.ListFillRange = "Клиенты!$B$2:$B$" + CStr(k - 1)
.EditBoxes(1).InputType = xlNumber
.EditBoxes(2).InputType = xlNumber
.Show
If Button = False Then
MsgBox "Данные не занесены"
Exit Sub
End If
CliNum = .DropDowns(1).List(.DropDowns(1).ListIndex)
If .EditBoxes(1).Text = "" Then
OstIn = 0
Else
OstIn = .EditBoxes(1).Text
End If
If .EditBoxes(2).Text = "" Then
OstOut = 0
Else
OstOut = .EditBoxes(2).Text
End If
OstBegin = 0
k = 2
DoFlag = True
Do While Cells(k; 1) <> Empty
If Cells(k; 2) = CliNum And DoFlag Then
If Cells(k; 1) < CurDate Then
OstBegin = Cells(k; 6)
Else
MsgBox "Невозможен ввод информации"
Exit Sub
End If
DoFlag = False
End If
k = k + 1
Loop
Cells(k; 1) = CurDate
Cells(k; 2) = CliNum
Cells(k; 3) = OstBegin
Cells(k; 4) = OstIn
Cells(k; 5) = OstOut
Cells(k; 6) = OstBegin + OstIn - OstOut
End With
End Sub
'-------------------------------- Просмотр остатков 812 ------------
Sub PrintOst()
Dim Sheet; Sheet1 As Object
Dim i; k; CliNum As Long
Dim Ost As Double
CurDate = Worksheets("Врем").Cells(1; 4)
i = 2
While Worksheets("Сделки").Cells(i; 1) <> Empty
If Worksheets("Сделки").Cells(i; 1) = CurDate Then
Call EditOstBirga(Worksheets("Сделки").Cells(i; 2))
End If
i = i + 1
Wend
Set Sheet = Worksheets("Остатки812")
Set Sheet1 = Worksheets("ОстаткиБиржа")
Sheets("Клиенты").Select
i = 2
Sheet.Range("B2").Sort Key1:=Sheet.Range("B2"); Order1:=xlAscending; _
Key2:=Sheet.Range("A2"); Order2:=xlDescending; _
Header:=xlYes; OrderCustom:=1; _
MatchCase:=False; Orientation:=xlTopToBottom
Sheet1.Range("B2").Sort Key1:=Sheet1.Range("B2"); Order1:=xlAscending; _
Key2:=Sheet1.Range("A2"); Order2:=xlDescending; _
Header:=xlYes; OrderCustom:=1; _
MatchCase:=False; Orientation:=xlTopToBottom
While Cells(i; 2) <> Empty
CliNum = Cells(i; 2)
k = 2
Do
If Sheet.Cells(k; 1) = Empty Then
Ost = 0
Exit Do
End If
If Sheet.Cells(k; 2) = CliNum Then
Ost = Sheet.Cells(k; 8)
Exit Do
End If
k = k + 1
Loop
Cells(i; 4) = Ost
k = 2
Do
If Sheet1.Cells(k; 1) = Empty Then
Ost = 0
Exit Do
End If
If Sheet1.Cells(k; 2) = CliNum Then
Ost = Sheet1.Cells(k; 6)
Exit Do
End If
k = k + 1
Loop
Cells(i; 5) = Ost
i = i + 1
Wend
End Sub
'-------------------------------- Печать портфель ------------------
Sub PrintPortfel()
Dim Sheet As Object
Dim i; k; BumNum; m As Long
Dim Bum(ConstMaxBum); DatePog(ConstMaxBum) As Long
Dim Volume(); BiginIndex(); dates(); V() As Integer
Dim Price(); BumPrice(); DohPog(); DohPriobr() As Double
Dim DateMas() As Date
Dim Flag; BumIndex() As Boolean
Dim SumPog1(); SumPog2(); SumPriobr1(); SumPriobr2() As Double
Dim SumPog11; SumPriobr11; SumPog22; SumPriobr22 As Double
Dim BumVol() As Integer
Dim AllVol As Long
Dim PortfelCost; PortfelBalance As Double
CurDate = Worksheets("Врем").Cells(1; 4)
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)
DatePog(BumNum + 1) = Sheet.Cells(i; 3)
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 DohPog(BumNum; MaxCount)
ReDim DohPriobr(BumNum; MaxCount)
ReDim dates(BumNum); V(BumNum); BeginIndex(BumNum)
ReDim BumIndex(BumNum); BumPrice(BumNum)
ReDim SumPog1(BumNum); SumPog2(BumNum); SumPriobr1(BumNum); SumPriobr2(BumNum)
ReDim BumVol(BumNum)
For i = 1 To BumNum
dates(i) = 1
Next i
i = 2
While Cells(i; 1) <> Empty
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 Cells(i; 1) <= CurDate Then
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)
Else
V(k) = V(k) - Cells(i; 6)
End If
End If
End If
cont:
i = i + 1
Wend
For k = 1 To BumNum
For i = dates(k) To 1 Step -1
If V(k) > Volume(k; i) Then
V(k) = V(k) - Volume(k; i)
Else
Volume(k; i) = V(k)
BeginIndex(k) = i
Exit For
End If
Next i
Next k
For k = 1 To BumNum
BumIndex(k) = False
If V(k) > 0 Then BumIndex(k) = True
Next k
i = 2
While Cells(i; 1) <= CurDate And Cells(i; 1) <> Empty
If (Cells(i; 1) = CurDate And Cells(i; 2) = DilerConst) _
And (Cells(i; 7) <> "зачисление" And Cells(i; 7) <> "списание") Then
For k = 1 To BumNum
If Cells(i; 3) = Bum(k) Then
BumIndex(k) = True
End If
Next k
End If
i = i + 1
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)
Else
V(k) = V(k) - Cells(i; 6)
End If
End If
cont:
i = i + 1
Wend
For k = 1 To BumNum
For i = dates(k) To 1 Step -1
If V(k) > Volume(k; i) Then
V(k) = V(k) - Volume(k; i)
Else
Volume(k; i) = V(k)
BeginIndex(k) = i
Exit For
End If
Next i
Next k
For k = 1 To BumNum
BumIndex(k) = False
If V(k) > 0 Then BumIndex(k) = True
Next k
ComBirga = Worksheets("Инфо").Cells(1; 2)
i = 2
While Cells(i; 1) <> Empty
If (Cells(i; 1) = CurDate And Cells(i; 2) = DilerConst) _
And (Cells(i; 7) <> "зачисление" And Cells(i; 7) <> "списание") Then
For k = 1 To BumNum
If Cells(i; 3) = Bum(k) Then
BumIndex(k) = True
If Not IsEmpty(Cells(i; 4)) Then
ComMas(k) = ComMas(k) + Format(Cells(i; 4) * Cells(i; 6) * ComBirga * 0,1 + 0,0001; "0,00")
Else
If Cells(i; 5) <> 100 Then
ComMas(k) = ComMas(k) + Format(Cells(i; 5) * Cells(i; 6) * ComBirga * 0,1 + 0,0001; "0,00")