Анализ эффективности вложений денежных средств в РКО
If .OptionButtons(3).Value = xlOn Then StrS = "Погашение"If .OptionButtons(4).Value = xlOn Then StrS = "Покупка / Продажа"
If .OptionButtons(5).Value = xlOn Then StrS = "Покупка / Погашение"
If .OptionButtons(5).Value = xlOn Then Auk = True
End With
Worksheets("Ордер").Select
Dim Pos812 As Integer
Dim Page; Page1 As Object
Set Page = Worksheets("ОтчетыИнвесторам")
Set Page1 = Worksheets("Клиенты")
Pos812 = 2
While (Page1.Cells(Pos812; 1) <> Empty) And (Worksheets("Клиенты").Cells(Pos812; 2) <> CliNum)
Pos812 = Pos812 + 1
Wend
If Page.Cells(14; 6) - Page.Cells(15; 6) > 0 Then
If MemoOrder(Index; Page.Cells(14; 6) - Page.Cells(15; 6); 6; 7; Pos812; _
StrS + " РКО за " + CStr(CurDate)) Then Exit Sub
Index = Index + 1
Else
If MemoOrder(Index; Page.Cells(15; 6) - Page.Cells(14; 6); 7; 6; Pos812; _
StrS + " РКО за " + CStr(CurDate)) Then Exit Sub
Index = Index + 1
End If
Dim SumS As Double
SumS = Page.Cells(16; 6) + Page.Cells(18; 6) + Page.Cells(20; 6)
If SumS > 0 Then
StrS = ""
If Page.Cells(18; 6) > 0 Then StrS = "Комиссия Дилера " + CStr(Page.Cells(18; 6)) + " в т.ч. НДС " + _
CStr(Format(Page.Cells(18; 6) / 6; "0,00"))
If Page.Cells(16; 6) > 0 And Not Auk Then StrS = StrS + " возмещение ком. ВКБ " + CStr(Page.Cells(16; 6)) + " в т.ч. НДС " + _
CStr(Format(Page.Cells(16; 6) / 6; "0,00"))
If CliNum = FilialConst Then
If MemoOrder(Index; SumS; 6; 7; Pos812; StrS) Then Exit Sub
Else
If Auk Then
StrS = StrS + " по приобретению на аукционе"
If MemoOrder(Index; Page.Cells(18; 6) + Page.Cells(20; 6); 6; 12; Pos812; StrS) Then Exit Sub
StrS = "Возмещение ком. ВКБ " + CStr(Page.Cells(16; 6)) + " в т.ч. НДС " + _
CStr(Format(Page.Cells(16; 6) / 6; "0,00"))
Index = Index + 1
If MemoOrder(Index; Page.Cells(16; 6); 6; 8; Pos812; StrS) Then Exit Sub
Else
If MemoOrder(Index; SumS; 6; 8; Pos812; StrS) Then Exit Sub
End If
End If
Index = Index + 1
End If
If CliNum <> FilialConst Then
If Len(StrComS) > 0 Then
StrComS = StrComS + "," + CStr(Right(CliNum; 3))
Else
StrComS = StrComS + CStr(Right(CliNum; 3))
End If
End If
If CliNum <> FilialConst Then ComSum = ComSum + Page.Cells(16; 6)
Worksheets("ОтчетыИнвесторам").Select
'---------------
Rows(CStr(m + 4) + ":" + CStr(m + 4)).RowHeight = 13,8
Rows(CStr(m + 4) + ":" + CStr(m + 4)).WrapText = False
Rows(CStr(m + 4) + ":" + CStr(m + 4)).HorizontalAlignment = xlRight
Rows(CStr(m + 4) + ":" + CStr(m + 4)).VerticalAlignment = xlBottom
Range(Cells(NN; 2); Cells(NN + 200; 6)).Delete shift:=xlToLeft
m = NN
FlagBuy = True
FlagCell = True
ComBirga = 0
sum = 0
SumBuy = 0
SumCom = 0
End If
End If
i = i + 1
Loop
If Not FlagDeal Then
MsgBox "Сделок в текущий день не было"
Else
If ComSum > 0 Then
Worksheets("Ордер").Select
If MemoOrder(Index; ComSum; 9; 7; 2; _
"Комиссия ВКБ по инвесторам " + StrComS + " в т.ч. НДС " + _
CStr(Format(ComSum / 6; "0,00"))) Then Exit Sub
End If
End If
End Sub
'-------------------------------- Печать Отчеты недельные ----------
Sub PrintOtchWeek()
Dim BumNum; CliNum; i; j; k; a; n; Sign; s As Integer
Dim Flag As Boolean
Dim Code As Long
Dim Str As String
Dim DepoFil() As Integer
Dim Num As Integer
CurDate = Worksheets("Врем").Cells(1; 4)
Call FormBum
Sheets("ОтчетНедельный").Select
BumNum = Worksheets("Врем").Cells(1; 2)
Num = 8
For i = 1 To BumNum
Cells(6; i + 1) = Worksheets("Врем").Cells(i; 1)
Cells(6; i + 1).Font.Bold = True
Cells(6; i + 1).Interior.ColorIndex = 40
Cells(Num; i + 1).Interior.ColorIndex = 15
Cells(Num; i + 1) = ""
Cells(5; i + 1).Interior.ColorIndex = 40
Next
Cells(Num; 1).Interior.ColorIndex = 15
Cells(Num; 1) = ""
Cells(5; 1).Interior.ColorIndex = 40
Cells(5; 1) = ""
Cells(6; 1).Interior.ColorIndex = 40
Cells(6; 1).Font.Bold = True
Cells(6; 1) = "№ бумаги"
Cells(7; 1) = "Дилер"
Cells(6; 1).HorizontalAlignment = xlCenter
Cells(7; 1).HorizontalAlignment = xlCenter
Cells(7; 1).Font.Bold = True
CliNum = Worksheets("Врем").Cells(1; 3)
ReDim DepoArray(CliNum; BumNum)
a = 2
While Worksheets("Сделки").Cells(a; 1) <> Empty
i = 1
While Worksheets("Клиенты").Cells(i + 1; 2) <> _
Worksheets("Сделки").Cells(a; 2)
If Worksheets("Клиенты").Cells(i + 1; 2) = Empty Then
MsgBox "Неверный номер клиента в Окне 'Сделки'"
Exit Sub
End If
i = i + 1
Wend
k = 0
For j = 1 To BumNum
If Worksheets("Врем").Cells(j; 1) = Worksheets("Сделки").Cells(a; 3) Then
k = j
Exit For
End If
Next
If k = 0 Then
a = a + 1
GoTo NNN
End If
If Not IsEmpty(Worksheets("Сделки").Cells(a; 4)) Then
Sign = 1
Else
Sign = -1
End If
If CurDate >= Worksheets("Сделки").Cells(a; 1) Then
DepoArray(i; k) = DepoArray(i; k) + Sign * Worksheets("Сделки").Cells(a; 6)
End If
a = a + 1
NNN:
Wend
For k = 1 To BumNum
DepoArray(1; k) = DepoArray(1; k) + DepoArray(2; k)
DepoArray(2; k) = 0
Next k
n = 7
For i = 1 To CliNum
Flag = False
For k = 1 To BumNum
If DepoArray(i; k) > 0 Then Flag = True
Next
If Flag Then
If n > 7 Then
Str = Format(Worksheets("Клиенты").Cells(i + 1; 2); "0000000000")
Str = Right(Str; 5)
Cells(n; 1).NumberFormat = "@"
Cells(n; 1).Font.Bold = True
Cells(n; 1).HorizontalAlignment = xlCenter
Cells(n; 1).Font.Italic = False
Cells(n; 1).Interior.ColorIndex = 2
Cells(n; 1) = Str
End If
For k = 1 To BumNum
If DepoArray(i; k) <> 0 Then
Cells(n; k + 1) = DepoArray(i; k)
Else
Cells(n; k + 1) = ""
End If
Cells(n; k + 1).Font.Bold = False
Cells(n; k + 1).Font.Italic = False
Cells(n; k + 1).Interior.ColorIndex = 2
Next
If n = 7 Then
n = n + 2
Else
n = n + 1
End If
End If
Next
For i = 1 To BumNum
Cells(n; i + 1).Interior.ColorIndex = 40
s = 0
For k = 9 To n - 1
s = s + Cells(k; i + 1)
Next
Cells(n; i + 1).Value = s
Next
Cells(n; 1).Interior.ColorIndex = 40
Cells(n; 1) = "Итого по инвесторам"
Cells(n; 1).Font.Bold = True
Cells(n; 1).Font.Italic = True
Range("A1:Z200").Borders(xlLeft).LineStyle = xlNone
Range("A1:Z200").Borders(xlRight).LineStyle = xlNone
Range("A1:Z200").Borders(xlTop).LineStyle = xlNone
Range("A1:Z200").Borders(xlBottom).LineStyle = xlNone
Range("A1:Z200").BorderAround LineStyle:=xlNone
Range(Cells(5; 1); Cells(n; BumNum + 1)).Borders(xlLeft).Weight = xlThin
Range(Cells(5; 1); Cells(n; BumNum + 1)).Borders(xlRight).Weight = xlThin
Range(Cells(5; 1); Cells(n; BumNum + 1)).Borders(xlTop).Weight = xlThin
Range(Cells(5; 1); Cells(n; BumNum + 1)).Borders(xlBottom).Weight = xlThin
Range(Cells(5; 1); Cells(n; BumNum + 1)).BorderAround Weight:=xlMedium
Range(Cells(n + 1; 1); Cells(100; 30)).Delete shift:=xlToLeft
Range(Cells(1; BumNum + 2); Cells(100; 30)).Delete shift:=xlToLeft
Range("a2") = "на " + CStr(CurDate)
Range(Cells(n + 2; 1); Cells(n + 3; BumNum + 1)).BorderAround Weight:=xlMedium
Cells(n + 2; 1) = "Количество перечисленных облигаций на счета ""Депо"""
Cells(n + 3; 1) = "без совершения сделок купли-продажи"
Cells(n + 2; 1).Font.Bold = True
Cells(n + 3; 1).Font.Bold = True
Cells(n + 5; 1).Font.Size = 12
Cells(n + 5; 1) = "Ответственное лицо Дилера " + _
" _________________________ "
Cells(n + 3; BumNum + 1) = 0
Cells(n + 3; BumNum + 1).Font.Bold = True
If DialogPrint("ОтчетНедельный"; 2) Then Exit Sub
End Sub
'-------------------------------- Печать Отчеты Месячные -----------
Sub PrintOtchMonth()
Dim DateBegin; DateEnd; DateMas() As Date
Dim i; k; m; NumberClients; kk As Long
Dim Sign; BumNum; Row; Col; Num; sum As Integer
Dim DateFlag; Flag; CliInput(); BumInput() As Boolean
Dim Bum(ConstMaxBum) As Long
Dim mas() As Integer
Dim Sheet As Object
Dim Str As String
With DialogSheets("ДиалогМесОтчет")
.EditBoxes(1).InputType = xlDate
.EditBoxes(2).InputType = xlDate
.Show
If Not Button Then Exit Sub
If IsDate(.EditBoxes(1).Text) = False Or _
IsDate(.EditBoxes(2).Text) = False Then
MsgBox "Неверно введены даты"
Exit Sub
End If
DateBegin = CDate(.EditBoxes(1).Text)
DateEnd = CDate(.EditBoxes(2).Text)
If DateBegin >= DateEnd Then
MsgBox "Даты не пересекаются"
Exit Sub
End If
End With
Set Sheet = Worksheets("Бумаги")
i = 2
BumNum = 0
While Sheet.Cells(i; 1) <> Empty
If (Sheet.Cells(i; 2) < DateBegin And Sheet.Cells(i; 3) > DateBegin) Or _
(Sheet.Cells(i; 2) < DateEnd And Sheet.Cells(i; 3) > DateEnd) Or _
(Sheet.Cells(i; 2) > DateBegin And Sheet.Cells(i; 3) < DateEnd) Then
Bum(BumNum + 1) = Sheet.Cells(i; 1)
BumNum = BumNum + 1
End If
i = i + 1
Wend
Set Sheet = Worksheets("Клиенты")
i = 2
k = 0
While Sheet.Cells(i; 1) <> Empty
If Sheet.Cells(i; 2) > k And Sheet.Cells(i; 2) <> FilialConst Then
k = Sheet.Cells(i; 2)
End If
i = i + 1
Wend
NumberClients = k - DilerConst
DateFlag = True
ReDim mas(NumberClients; BumNum * 7)
ReDim DateMas(NumberClients; BumNum)
ReDim CliInput(NumberClients)
ReDim BumInput(BumNum)
i = 2
Worksheets("Сделки").Select
While Cells(i; 1) <> Empty
If Cells(i; 2) <> DilerConst And Cells(i; 2) <> FilialConst Then
If Cells(i; 1) < DateBegin Then