Данная программа написана на Microsoft Visual Basic for Excel. Для запуска программы необходимо открыть файл sprav.xls в Excel, после чего в линейке меню появится дополнительный пункт меню «Справочник», состоящий из следующих разделов:
Дата
Просмотр остатков
Печать
Депозитарий
Портфель
Биржевая информация
Отчеты клиентам
Отчет недельный
Отчет месячный
Журнал лицевого учета
Окно
Бумаги
Сделки
Клиенты
Биржа
Рассмотрим подробнее каждое из пунктов меню.
Дата
- изменение даты для работы.
Просмотр остатков
- просмотр остатков по Клиентам.
Печать
- распечатка на принтер следующих данных:
Депозитарий - печать депозитария.
Портфель - печать собственного портфеля Дилера.
Биржевая информация - печать биржевой информации.
Отчеты клиентам - печать отчетов Клиентам.
Отчет недельный - печать еженедельного отчета, предоставляемого в депозитарий.
Отчет месячный - печать ежемесячного отчета, предоставляемого в депозитарий.
Журнал лицевого учета - печать журнала лицевого учета и журнала оборотов Дилера.
Окно
- выбор следующих окон для ввода информации:
Бумаги - выбор окна ввода информации об обращающихся на рынке бумагах.
Сделки - выбор окна ввода сделок.
Клиенты - выбор окна ввода Клиентов.
Биржа - выбор окна ввода биржевой информации.
Результатом работы программы являются Приложения №1.3-1.12
Option Explicit
Option Base 1
Public CurDate As Date
Public DepoArray() As Integer
Public BumArray(); BumArrayV() As Integer
Public Button; Просмотр; ExitVar; Покупка; Продажа; Погашение As Boolean
Const DilerConst = 1000900000
Const FilialConst = 1000999999
Const ConstMaxBum = 100 ' максимальное кол-во бумаг(выпусков)
Const MaxCount = 1000 ' максимальное кол-во сделок по 1-ой бумаге
Const S192 = "50202"
Const S904 = "47423"
Const S960 = "70102"
Const S970 = "70204"
Const SR970 = "70204"
Sub Auto_Open()
ActiveWindow.WindowState = xlMaximized
CurDate = Date
Worksheets("Врем").Cells(1; 4) = CurDate
Application.OnWindow = "CancelChanges"
Application.Windows("Sprav.xls").OnWindow = "Start"
End Sub
Sub Auto_Close()
MenuBars(xlModule).Reset
MenuBars(xlWorksheet).Reset
Application.OnWindow = ""
Application.Windows("Sprav.xls").OnWindow = ""
ActiveWorkbook.Save
End Sub
Sub Start()
Call CreateMenu
Application.DisplayFullScreen = False
ActiveWindow.WindowState = xlMaximized
CurDate = Date
Worksheets("Врем").Cells(1; 4) = CurDate
End Sub
Sub CancelChanges()
MenuBars(xlModule).Reset
MenuBars(xlWorksheet).Reset
End Sub
Sub CreateMenu()
MenuBars(xlModule).Reset
MenuBars(xlWorksheet).Reset
With MenuBars(xlModule).Menus.Add("&Справочник")
.MenuItems.Add "&Дата"; "DateChange"
.MenuItems.Add "П&росмотр остатков"; "PrintOst"
.MenuItems.AddMenu ("&Печать")
.MenuItems("&Печать").MenuItems.Add "&Депозитарий"; "PrintDepo"
.MenuItems("&Печать").MenuItems.Add "&Портфель"; "PrintPortfel"
.MenuItems("&Печать").MenuItems.Add "&Биржевая информация"; "PrintBirgaInfo"
.MenuItems("&Печать").MenuItems.Add "Отчеты &клиентам"; "PrintOtchClient"
.MenuItems("&Печать").MenuItems.Add "Отчет &недельный"; "PrintOtchWeek"
.MenuItems("&Печать").MenuItems.Add "Отчет &месячный"; "PrintOtchMonth"
.MenuItems("&Печать").MenuItems.Add "Журнал &лицевого учета"; "PrintMagazine"
.MenuItems.AddMenu ("&Окно")
.MenuItems("&Окно").MenuItems.Add "&Бумаги"; "ViewPaper"
.MenuItems("&Окно").MenuItems.Add "&Сделки"; "ViewDeal"
.MenuItems("&Окно").MenuItems.Add "&Клиенты"; "ViewClient"
.MenuItems("&Окно").MenuItems.Add "Би&ржа"; "ViewBirga"
.MenuItems("&Окно").MenuItems.Add "&Остатки 812"; "ViewOst812"
.MenuItems("&Окно").MenuItems.Add "О&статки биржа"; "ViewOstBirga"
.MenuItems("&Окно").MenuItems.Add "&Защита"; "ViewProgram"
End With
With MenuBars(xlWorksheet).Menus.Add("&Справочник")
.MenuItems.Add "&Дата"; "DateChange"
.MenuItems.Add "П&росмотр остатков"; "PrintOst"
.MenuItems.AddMenu ("&Печать")
.MenuItems("&Печать").MenuItems.Add "&Депозитарий"; "PrintDepo"
.MenuItems("&Печать").MenuItems.Add "&Портфель"; "PrintPortfel"
.MenuItems("&Печать").MenuItems.Add "&Биржевая информация"; "PrintBirgaInfo"
.MenuItems("&Печать").MenuItems.Add "Отчеты &клиентам"; "PrintOtchClient"
.MenuItems("&Печать").MenuItems.Add "Отчет &недельный"; "PrintOtchWeek"
.MenuItems("&Печать").MenuItems.Add "Отчет &месячный"; "PrintOtchMonth"
.MenuItems("&Печать").MenuItems.Add "Журнал &лицевого учета"; "PrintMagazine"
.MenuItems.AddMenu ("&Окно")
.MenuItems("&Окно").MenuItems.Add "&Бумаги"; "ViewPaper"
.MenuItems("&Окно").MenuItems.Add "&Сделки"; "ViewDeal"
.MenuItems("&Окно").MenuItems.Add "&Клиенты"; "ViewClient"
.MenuItems("&Окно").MenuItems.Add "Би&ржа"; "ViewBirga"
.MenuItems("&Окно").MenuItems.Add "&Остатки 812"; "ViewOst812"
.MenuItems("&Окно").MenuItems.Add "О&статки биржа"; "ViewOstBirga"
.MenuItems("&Окно").MenuItems.Add "&Защита"; "ViewProgram"
End With
End Sub
Sub ViewPaper()
Sheets("Бумаги").Select
Call EndOf
End Sub
Sub ViewDeal()
Sheets("Сделки").Select
Call EndOf
End Sub
Sub ViewClient()
Sheets("Клиенты").Select
Call EndOf
End Sub
Sub ViewBirga()
Sheets("Биржа").Select
Call EndOf
End Sub
Sub ViewOst812()
Sheets("Остатки812").Select
Call EndOf
End Sub
Sub ViewOstBirga()
Sheets("ОстаткиБиржа").Select
Call EndOf
End Sub
Sub ViewProgram()
Sheets("Защита").Select
End Sub
'------------------------------ Печать Депозитария ---------------
Sub PrintDepo()
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)
Cells(3; 5) = Worksheets("Врем").Cells(1; 4)
Cells(3; 5).NumberFormat = "Д ММММ, ГГГГ"
Cells(3; 5).HorizontalAlignment = xlCenterAcrossSelection
Cells(3; 5).Font.Bold = True
Num = 9
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 + 1; i + 1).Interior.ColorIndex = 15
Cells(Num + 1; i + 1) = ""
Cells(Num; i + 1).Interior.ColorIndex = 40
Cells(Num; i + 1) = ""
Cells(5; i + 1).Interior.ColorIndex = 40
Next
Cells(Num; 1).Interior.ColorIndex = 40
Cells(Num; 1) = "Итого"
Cells(Num; 1).Font.Bold = True
Cells(Num; 1).Font.Italic = True
Cells(Num; 1).HorizontalAlignment = xlCenter
Cells(Num + 1; 1) = ""
Cells(Num + 1; 1).Interior.ColorIndex = 15
CliNum = Worksheets("Врем").Cells(1; 3)
ReDim DepoArray(CliNum; BumNum)
ReDim DepoFil(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 "Неверный номер клиента в Окне 'Сделки' строка: " + CStr(a)
Sheets("Сделки").Select
Cells(a; 2).Select
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
If Worksheets("Сделки").Cells(a; 2) = FilialConst Then
DepoFil(k) = DepoFil(k) + Sign * Worksheets("Сделки").Cells(a; 6)
Else
DepoArray(i; k) = DepoArray(i; k) + Sign * Worksheets("Сделки").Cells(a; 6)
End If
End If
a = a + 1
NNN:
Wend
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
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
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 + 4
Else
n = n + 1
End If
End If
Next
'расчет по филиалу
Cells(8; 1) = "Филиал"
Cells(8; 1).Font.Bold = True
Cells(8; 1).HorizontalAlignment = xlCenter
Cells(8; 1).Font.Italic = False
Cells(8; 1).Interior.ColorIndex = 2
For k = 1 To BumNum
If DepoFil(k) <> 0 Then
Cells(8; k + 1) = DepoFil(k)
Else
Cells(8; k + 1) = ""
End If
Cells(8; k + 1).Font.Bold = False
Cells(8; k + 1).Font.Italic = False
Cells(8; k + 1).Interior.ColorIndex = 2
Next
For i = 1 To BumNum
Cells(n; i + 1).Interior.ColorIndex = 40
s = 0
For k = 11 To n - 1
s = s + Cells(k; i + 1)
Next
Cells(n; i + 1).Value = s
Next
For i = 1 To BumNum
Cells(9; i + 1) = Cells(7; i + 1) + Cells(8; i + 1)
Next
Cells(n; 1).Interior.ColorIndex = 40
Cells(n; 1) = "Итого 9998"
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
If DialogPrint("Депо"; 1) Then Exit Sub
Call EditOstBirga(DilerConst)
End Sub
'-------------------------------- Печать Отчеты клиентам -----------
Sub PrintOtchClient()
Dim Sheet; Ost812 As Object
Dim i; j; d; a; Col; m; MM; NN; MMM; k; b; q As Long
Dim FlagBuy; FlagCell; FlagDeal; FlagDepo As Boolean
Dim CliNum As Long
Dim ComStr; StrComS As String
Dim BumNum; z; z1; Index As Integer
Dim s; sum; SumBuy; Ost; SumCom; ComBirga; ComDiler; ComSum As Double
Dim Com As Double
Dim OstIn; OstOut; OstBegin; OstEnd As Double
Dim RowNum As Long
Dim OstInDate; OstOutDate As String
Dim DoFlag As Boolean
Dim Auk As Boolean
Set Sheet = Worksheets("Сделки")
Sheet.Range("A2").Sort Key1:=Sheet.Range("A2"); Order1:=xlAscending; _
Key2:=Sheet.Range("B2"); Order2:=xlAscending; _
Key3:=Sheet.Range("D2"); Order3:=xlAscending; _
Header:=xlYes; OrderCustom:=1; _
MatchCase:=False; Orientation:=xlTopToBottom
CurDate = Worksheets("Врем").Cells(1; 4)
Worksheets("ОтчетыИнвесторам").Select
i = 2
FlagDeal = False
FlagBuy = True
FlagCell = True
NN = 29 ' начало
m = NN
Range(Cells(NN - 1; 2); Cells(NN + 200; 6)).Delete shift:=xlToLeft
Rows(CStr(NN - 1) + ":" + CStr(NN - 1)).RowHeight = 28
Rows(CStr(NN - 1) + ":" + CStr(NN - 1)).WrapText = True
Rows(CStr(NN - 1) + ":" + CStr(NN - 1)).HorizontalAlignment = xlCenter
Rows(CStr(NN - 1) + ":" + CStr(NN - 1)).VerticalAlignment = xlBottom
Cells(NN - 1; 2) = "№ выпуска"
Cells(NN - 1; 3) = "Дата погашения"
Cells(NN - 1; 4) = "Цена сделки"
Cells(NN - 1; 5) = "Количество"
Cells(NN - 1; 6) = "Сумма сделки"
Cells(NN - 3; 3) = "Совершенные сделки на рынке РКО"
Cells(NN - 3; 3).Font.Bold = True
sum = 0
SumBuy = 0
SumCom = 0
ComBirga = 0
Call FormBum
BumNum = Worksheets("Врем").Cells(1; 2)
ReDim BumArray(BumNum)
ReDim BumArrayV(BumNum)
Index = CInt(InputBox("Введите номер 1-го ордера"))
Do While Sheet.Cells(i; 1) <> Empty
If Sheet.Cells(i; 1) = CurDate And Sheet.Cells(i; 2) <> DilerConst Then
FlagDeal = True
If FlagBuy And Sheet.Cells(i; 4) <> Empty Then
Покупка = True
CliNum = Sheet.Cells(i; 2)
Cells(m; 2) = "Покупка"
Cells(m; 2).HorizontalAlignment = xlLeft
Range(Cells(m; 2); Cells(m; 6)).Interior.ColorIndex = 15
m = m + 1
MM = m
FlagBuy = False
End If
If FlagCell And Sheet.Cells(i; 4) = Empty Then
If Not FlagBuy Then
s = 0
Col = 0
SumCom = 0
ComBirga = 0
For a = MM To m - 1
Cells(a; 6) = Cells(a; 4) * Cells(a; 5) * 10
If Cells(a; 4) <> 100 Then
SumCom = SumCom + Cells(a; 4) * Cells(a; 5) * 10
ComBirga = ComBirga + _
CDbl(Format(Cells(a; 4) * Cells(a; 5) * 0,1 * Worksheets("Инфо").Cells(1; 2) + 0,001; "0,00"))
Else
Погашение = True
End If
Cells(a; 6).NumberFormat = "# ###"
s = s + Cells(a; 6)
Col = Col + Cells(a; 5)
Next a
sum = sum + s
SumBuy = s
Cells(m; 6) = s
Cells(m; 6).NumberFormat = "# ###"
Cells(m; 5) = Col
Cells(m; 2) = "Итого"
m = m + 1
End If
CliNum = Sheet.Cells(i; 2)
Cells(m; 2) = "Продажа"
Продажа = True
Cells(m; 2).HorizontalAlignment = xlLeft
Range(Cells(m; 2); Cells(m; 6)).Interior.ColorIndex = 15
m = m + 1
MM = m
FlagCell = False
End If
Cells(m; 2) = Sheet.Cells(i; 3)
q = 2
While Worksheets("Бумаги").Cells(q; 1) <> Empty
If Worksheets("Бумаги").Cells(q; 1) = Cells(m; 2) Then
Cells(m; 3) = Worksheets("Бумаги").Cells(q; 3)
Cells(m; 3).NumberFormat = "ДД.ММ.ГГ"
End If
q = q + 1
Wend
If Sheet.Cells(i; 4) <> Empty Then
Cells(m; 4) = Sheet.Cells(i; 4)
Else
Cells(m; 4) = Sheet.Cells(i; 5)
End If
Cells(m; 4).NumberFormat = "0,00"
Cells(m; 5) = Sheet.Cells(i; 6)
m = m + 1
If CliNum <> Sheet.Cells(i + 1; 2) Or Sheet.Cells(i + 1; 1) <> CurDate Then
s = 0
Col = 0
For a = MM To m - 1
Cells(a; 6) = Cells(a; 4) * Cells(a; 5) * 10
If Cells(a; 4) <> 100 Then
SumCom = SumCom + Cells(a; 4) * Cells(a; 5) * 10
ComBirga = ComBirga + _
CDbl(Format(Cells(a; 4) * Cells(a; 5) * 0,1 * Worksheets("Инфо").Cells(1; 2) + 0,001; "0,00"))
Else
Погашение = True
End If
Cells(a; 6).NumberFormat = "# ###,00"
s = s + Cells(a; 6)
Col = Col + Cells(a; 5)
Next a
sum = sum + s
If FlagCell Then SumBuy = s
Cells(m; 6) = s
Cells(m; 6).NumberFormat = "# ###,00"
Cells(m; 5) = Col
Cells(m; 2) = "Итого"
Cells(5; 4) = CliNum
If CliNum = FilialConst Then Cells(5; 4) = DilerConst
k = 2
While Worksheets("Клиенты").Cells(k; 1) <> Empty
If Worksheets("Клиенты").Cells(k; 2) = CliNum Then
Cells(4; 4) = Worksheets("Клиенты").Cells(k; 1)
End If
k = k + 1
Wend
Range(Cells(NN - 1; 2); Cells(m; 6)).Borders(xlLeft).Weight = xlThin
Range(Cells(NN - 1; 2); Cells(m; 6)).Borders(xlRight).Weight = xlThin
Range(Cells(NN - 1; 2); Cells(m; 6)).Borders(xlTop).Weight = xlThin
Range(Cells(NN - 1; 2); Cells(m; 6)).Borders(xlBottom).Weight = xlThin
Range(Cells(NN - 1; 2); Cells(m; 6)).BorderAround Weight:=xlMedium
For b = 1 To BumNum
BumArray(b) = 0
BumArrayV(b) = 0
Next
b = 2
While Worksheets("Сделки").Cells(b; 1) <> Empty
If CurDate >= Worksheets("Сделки").Cells(b; 1) And _
CliNum = Worksheets("Сделки").Cells(b; 2) Then
z = 0
For z1 = 1 To BumNum
If Worksheets("Врем").Cells(z1; 1) = Worksheets("Сделки").Cells(b; 3) Then
z = z1
Exit For
End If
Next
If z <> 0 Then
If Not IsEmpty(Worksheets("Сделки").Cells(b; 4)) Then
If CurDate > Worksheets("Сделки").Cells(b; 1) Then
BumArrayV(z) = BumArrayV(z) + Worksheets("Сделки").Cells(b; 6)
End If
BumArray(z) = BumArray(z) + Worksheets("Сделки").Cells(b; 6)
Else
If CurDate > Worksheets("Сделки").Cells(b; 1) Then
BumArrayV(z) = BumArrayV(z) - Worksheets("Сделки").Cells(b; 6)
End If
BumArray(z) = BumArray(z) - Worksheets("Сделки").Cells(b; 6)
End If
End If
End If
b = b + 1
Wend
' M+4
MMM = m + 5
Rows(CStr(m + 1) + ":" + CStr(m + 200)).Delete
FlagDepo = False
For b = 1 To BumNum
If BumArray(b) > 0 Or BumArrayV(b) > 0 Then
FlagDepo = True
Cells(MMM; 2) = Worksheets("Врем").Cells(b; 1)
If BumArrayV(b) < BumArray(b) Then
Cells(MMM; 4) = BumArray(b) - BumArrayV(b)
Else
If BumArrayV(b) > BumArray(b) Then
Cells(MMM; 5) = BumArrayV(b) - BumArray(b)
End If
End If
Cells(MMM; 3) = BumArrayV(b)
Cells(MMM; 6) = BumArray(b)
MMM = MMM + 1
End If
Next
If FlagDepo Then
Rows(CStr(m + 4) + ":" + CStr(m + 4)).RowHeight = 28
Rows(CStr(m + 4) + ":" + CStr(m + 4)).WrapText = True
Rows(CStr(m + 4) + ":" + CStr(m + 4)).HorizontalAlignment = xlCenter
Rows(CStr(m + 4) + ":" + CStr(m + 4)).VerticalAlignment = xlBottom
Cells(m + 4; 2) = "№ выпуска"
Cells(m + 4; 3) = "Входящий остаток"
Cells(m + 4; 4) = "Куплено"
Cells(m + 4; 5) = "Продано/ Погашено"
Cells(m + 4; 6) = "Исходящий остаток"
Cells(m + 2; 3).Font.Bold = True
Cells(m + 2; 3) = "Количество бумаг, принадлежащих Инвестору (штук)"
Range(Cells(m + 4; 2); Cells(MMM - 1; 6)).Borders(xlLeft).Weight = xlThin
Range(Cells(m + 4; 2); Cells(MMM - 1; 6)).Borders(xlRight).Weight = xlThin
Range(Cells(m + 4; 2); Cells(MMM - 1; 6)).Borders(xlTop).Weight = xlThin
Range(Cells(m + 4; 2); Cells(MMM - 1; 6)).Borders(xlBottom).Weight = xlThin
Range(Cells(m + 4; 2); Cells(MMM - 1; 6)).BorderAround Weight:=xlMedium
End If
' ------------------------------------------------------
' - расчет остатков
Set Ost812 = Worksheets("Остатки812")
Ost812.Range("B2").Sort Key1:=Ost812.Range("B2"); Order1:=xlAscending; _
Key2:=Ost812.Range("A2"); Order2:=xlDescending; _
Header:=xlYes; OrderCustom:=1; _
MatchCase:=False; Orientation:=xlTopToBottom
OstIn = 0
OstOut = 0
OstBegin = 0
OstInDate = ""
OstOutDate = ""
RowNum = 0
k = 2
DoFlag = True
Do While Ost812.Cells(k; 1) <> Empty
If Ost812.Cells(k; 2) = CliNum And DoFlag Then
If Ost812.Cells(k; 1) < CurDate Then
OstBegin = Ost812.Cells(k; 8)
Else
Do While Ost812.Cells(k; 1) <> Empty
If Ost812.Cells(k; 2) <> CliNum Then Exit Do
If Ost812.Cells(k; 1) = CurDate Then
OstBegin = Ost812.Cells(k; 3)
OstIn = Ost812.Cells(k; 4)
OstInDate = Ost812.Cells(k; 5)
OstOut = Ost812.Cells(k; 6)
OstOutDate = Ost812.Cells(k; 7)
RowNum = k
Exit Do
End If
k = k + 1
Loop
End If
DoFlag = False
End If
k = k + 1
Loop
If RowNum = 0 Then RowNum = k
k = RowNum
' - начало таблицы
With DialogSheets("ДиалогКлиент")
.Labels(8).Text = Cells(4; 4) ' Клиент
.Labels(9).Text = sum ' Сумма сделки
.Labels(10).Text = CurDate ' Дата текущая
.Labels(17).Text = CliNum
If CliNum = FilialConst Then .Labels(17).Text = DilerConst
.EditBoxes(1).Text = "0" ' Сумма списания
.EditBoxes(1).InputType = xlNumber
.EditBoxes(2).Text = CurDate ' Дата сделки
.EditBoxes(7).Text = OstOutDate ' списано (дата)
.EditBoxes(8).Text = OstOut ' списано (сумма)
.EditBoxes(8).InputType = xlNumber
.EditBoxes(9).Text = OstInDate ' перечислено (дата)
.EditBoxes(10).Text = OstIn ' перечислено (сумма)
.EditBoxes(10).InputType = xlNumber
Com = 0,00015
Select Case SumCom
Case Is < 36000
Com = 0,005
Case Is < 51000
Com = 0,004
Case Is < 101000
Com = 0,003
Case Is < 301000
Com = 0,002
Case Is < 501000
Com = 0,001
Case Is < 1001000
Com = 0,0005
Case Is < 3001000
Com = 0,00025
End Select
If Cells(4; 4) = "Универсалбанк" Then Com = 0
.EditBoxes(3).Text = Com ' Комиссия дилера
.EditBoxes(3).InputType = xlNumber
.EditBoxes(4).Text = "0" ' Сумма вознаграждения дилера
.EditBoxes(4).InputType = xlNumber
.EditBoxes(5).Text = "" ' Запись о вознаграждении
.EditBoxes(6).Text = OstBegin ' Остаток на 812 счете клиента
.EditBoxes(6).InputType = xlNumber
Cells(MMM + 3; 1) = "Начальник инвестиционно-аналитического отдела_________________"
Cells(MMM + 3; 6) = ""
Again:
Просмотр = False
ExitVar = False
Button = False
.Show
If .EditBoxes(1).Text = "" Then .EditBoxes(1).Text = 0
If .EditBoxes(3).Text = "" Then .EditBoxes(3).Text = 0
If .EditBoxes(4).Text = "" Then .EditBoxes(4).Text = 0
If .EditBoxes(6).Text = "" Then .EditBoxes(6).Text = 0
If .EditBoxes(8).Text = "" Then .EditBoxes(8).Text = 0
If .EditBoxes(10).Text = "" Then .EditBoxes(10).Text = 0
Cells(21; 1) = .EditBoxes(5).Text ' Запись о вознаграждении
Cells(21; 1).Font.Italic = True
Cells(6; 4) = .EditBoxes(2).Text ' Дата сделки
' занесение данных в итоговую таблицу
Cells(10; 6) = .EditBoxes(6).Text ' Входящий остаток
OstBegin = .EditBoxes(6).Text
Cells(14; 6) = SumBuy
Cells(15; 6) = sum - SumBuy
ComStr = Format(SumCom * .EditBoxes(3).Text; "0,00")
ComDiler = CDbl(ComStr)
Cells(16; 6) = ComBirga
Cells(18; 6) = ComDiler
Cells(20; 6) = .EditBoxes(4).Text
Cells(11; 6) = .EditBoxes(8).Text
OstOut = .EditBoxes(8).Text
OstIn = .EditBoxes(10).Text
Cells(12; 6) = .EditBoxes(10).Text
Cells(13; 6) = .EditBoxes(6).Text - .EditBoxes(8).Text + .EditBoxes(10).Text
Cells(11; 1) = "2.Списано на р/с / выдано наличными " + .EditBoxes(7).Text
OstInDate = .EditBoxes(9).Text
OstOutDate = .EditBoxes(7).Text
Cells(12; 1) = "3.Перечислено на покупку " + .EditBoxes(9).Text
Cells(22; 6) = 2 * SumBuy - sum + ComBirga + ComDiler
Cells(23; 6) = .EditBoxes(1).Text
Cells(24; 6) = .EditBoxes(6).Text - .EditBoxes(8).Text + .EditBoxes(10).Text - _
(2 * SumBuy - sum + ComBirga + ComDiler) - _
.EditBoxes(1).Text - .EditBoxes(4).Text
OstEnd = Cells(24; 6)
Ost812.Cells(k; 1) = CurDate
Ost812.Cells(k; 2) = CliNum
Ost812.Cells(k; 3) = OstBegin
Ost812.Cells(k; 4) = OstIn
Ost812.Cells(k; 5) = OstInDate
Ost812.Cells(k; 6) = OstOut
Ost812.Cells(k; 7) = OstOutDate
Ost812.Cells(k; 8) = OstEnd
Ost812.Cells(k; 9) = Cells(14; 6) + Cells(15; 6)
Ost812.Cells(k; 10) = Cells(16; 6)
Ost812.Cells(k; 11) = Cells(18; 6)
Call EditOstBirga(CliNum)
' конец занесения данных
If Просмотр Then
Worksheets("ОтчетыИнвесторам").PrintPreview
GoTo Again
End If
If Button Then ActiveWindow.SelectedSheets.PrintOut copies:=2
If ExitVar Then Exit Sub
End With
' печать мемориальных ордеров
Dim StrS As String
Auk = False
With DialogSheets("ДиалогОперация")
.Show
If .OptionButtons(1).Value = xlOn Then StrS = "Покупка"
If .OptionButtons(2).Value = xlOn Then StrS = "Продажа"
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
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
Sign = 1
If IsEmpty(Cells(i; 4)) Then Sign = -1
mas(Cells(i; 2) - DilerConst; (k - 1) * 7 + 1) = _
mas(Cells(i; 2) - DilerConst; (k - 1) * 7 + 1) + Sign * Cells(i; 6)
End If
If Cells(i; 1) >= DateBegin And DateFlag Then
For k = 1 To NumberClients
For m = 1 To BumNum
mas(k; (m - 1) * 7 + 2) = mas(k; (m - 1) * 7 + 1)
Next m
Next k
DateFlag = False
End If
If Cells(i; 1) >= DateBegin And Cells(i; 1) <= DateEnd 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; 7) <> "списание" And Cells(i; 7) <> "зачисление" Then
If Not IsEmpty(Cells(i; 4)) Then
mas(Cells(i; 2) - DilerConst; (k - 1) * 7 + 3) = _
mas(Cells(i; 2) - DilerConst; (k - 1) * 7 + 3) + Cells(i; 6)
Else
mas(Cells(i; 2) - DilerConst; (k - 1) * 7 + 4) = _
mas(Cells(i; 2) - DilerConst; (k - 1) * 7 + 4) + Cells(i; 6)
End If
If DateMas(Cells(i; 2) - DilerConst; k) <> Cells(i; 1) Then
DateMas(Cells(i; 2) - DilerConst; k) = Cells(i; 1)
mas(Cells(i; 2) - DilerConst; (k - 1) * 7 + 5) = _
mas(Cells(i; 2) - DilerConst; (k - 1) * 7 + 5) + 1
End If
End If
If Cells(i; 7) = "списание" Then
mas(Cells(i; 2) - DilerConst; (k - 1) * 7 + 6) = _
mas(Cells(i; 2) - DilerConst; (k - 1) * 7 + 6) + Cells(i; 6)
End If
If Cells(i; 7) = "зачисление" Then
mas(Cells(i; 2) - DilerConst; (k - 1) * 7 + 7) = _
mas(Cells(i; 2) - DilerConst; (k - 1) * 7 + 7) + Cells(i; 6)
End If
Sign = 1
If IsEmpty(Cells(i; 4)) Then Sign = -1
mas(Cells(i; 2) - DilerConst; (k - 1) * 7 + 2) = _
mas(Cells(i; 2) - DilerConst; (k - 1) * 7 + 2) + Sign * Cells(i; 6)
End If
End If
cont:
i = i + 1
Wend
For i = 1 To NumberClients
CliInput(i) = False
For k = 1 To BumNum
If mas(i; (k - 1) * 7 + 1) > 0 Or _
mas(i; (k - 1) * 7 + 2) > 0 Or _
mas(i; (k - 1) * 7 + 3) > 0 Or _
mas(i; (k - 1) * 7 + 4) > 0 Or _
mas(i; (k - 1) * 7 + 5) > 0 Or _
mas(i; (k - 1) * 7 + 6) > 0 Or _
mas(i; (k - 1) * 7 + 7) > 0 Then CliInput(i) = True
Next k
Next i
For k = 1 To BumNum
BumInput(k) = False
For i = 1 To NumberClients
If mas(i; (k - 1) * 7 + 1) > 0 Or _
mas(i; (k - 1) * 7 + 2) > 0 Or _
mas(i; (k - 1) * 7 + 3) > 0 Or _
mas(i; (k - 1) * 7 + 4) > 0 Or _
mas(i; (k - 1) * 7 + 5) > 0 Or _
mas(i; (k - 1) * 7 + 6) > 0 Or _
mas(i; (k - 1) * 7 + 7) > 0 Then BumInput(k) = True
Next i
Next k
Worksheets("ОтчетМесячный").Select
Range(Cells(7; 1); Cells(800; 22)).Delete shift:=xlToLeft
Row = 4
Col = 2
Cells(2; 1) = "за период от " + CStr(DateBegin) + " до " + CStr(DateEnd)
kk = 0
Flag = False
For k = 1 To BumNum
If BumInput(k) Then
Cells(Row; Col) = Bum(k)
Num = 0
For i = 1 To NumberClients
If CliInput(i) Then
If Col = 2 Then
Str = Format(i; "0000000000")
Str = Right(Str; 5)
Cells(Row + Num + 3; Col - 1).NumberFormat = "@"
Cells(Row + Num + 3; Col - 1).Font.Bold = True
Cells(Row + Num + 3; Col - 1).HorizontalAlignment = xlCenter
Cells(Row + Num + 3; Col - 1).Font.Italic = False
Cells(Row + Num + 3; Col - 1).Interior.ColorIndex = 2
Cells(Row + Num + 3; Col - 1) = Str
End If
Cells(Row + Num + 3; Col) = mas(i; (k - 1) * 7 + 1)
Cells(Row + Num + 3; Col + 1) = mas(i; (k - 1) * 7 + 2)
Cells(Row + Num + 3; Col + 2) = mas(i; (k - 1) * 7 + 3)
Cells(Row + Num + 3; Col + 3) = mas(i; (k - 1) * 7 + 4)
Cells(Row + Num + 3; Col + 4) = mas(i; (k - 1) * 7 + 5)
Cells(Row + Num + 3; Col + 5) = mas(i; (k - 1) * 7 + 6)
Cells(Row + Num + 3; Col + 6) = mas(i; (k - 1) * 7 + 7)
Num = Num + 1
End If
Next i
Col = Col + 7
kk = kk + 1
Flag = True
End If
If ((kk > 0) And (kk Mod 3 = 0) And Flag) Or k = BumNum Then
Flag = False
For i = 2 To 22
sum = 0
For m = 1 To NumberClients
sum = sum + Cells(m + 6; i)
Next m
Cells(Num + 7; i) = sum
Cells(Num + 7; i).Font.Bold = True
Cells(Num + 7; i).Interior.ColorIndex = 15
Next i
Cells(Num + 7; 1) = "Итого"
Cells(Num + 7; 1).Font.Bold = True
Cells(Num + 7; 1).HorizontalAlignment = xlCenter
Cells(Num + 7; 1).Interior.ColorIndex = 15
Range(Cells(7; 1); Cells(Num + 7; 22)).Borders(xlLeft).Weight = xlThin
Range(Cells(7; 1); Cells(Num + 7; 22)).Borders(xlRight).Weight = xlThin
Range(Cells(7; 1); Cells(Num + 7; 22)).Borders(xlTop).Weight = xlThin
Range(Cells(7; 1); Cells(Num + 7; 22)).Borders(xlBottom).Weight = xlThin
Range(Cells(7; 1); Cells(Num + 7; 22)).BorderAround Weight:=xlMedium
Range(Cells(7; 9); Cells(Num + 7; 15)).BorderAround Weight:=xlMedium
Cells(Num + 10; 10) = "Ответственное лицо Дилера______________________________"
If DialogPrint("ОтчетМесячный"; 2) Then Exit Sub
Row = 4
Col = 2
Cells(Row; Col) = " "
Cells(Row; Col + 7) = " "
Cells(Row; Col + 14) = " "
Range(Cells(7; 1); Cells(800; 22)).Delete shift:=xlToLeft
End If
Next k
Worksheets("СписокКлиентов").Select
Num = 5
Range(Cells(Num; 1); Cells(100; 3)).Delete shift:=xlToLeft
For i = 1 To NumberClients
If CliInput(i) Then
k = 2
While Sheet.Cells(k; 2) <> DilerConst + i
k = k + 1
Wend
Cells(Num; 1) = Sheet.Cells(k; 1)
Cells(Num; 2) = Sheet.Cells(k; 2)
Cells(Num; 3) = Sheet.Cells(k; 3)
Cells(Num; 1).HorizontalAlignment = xlLeft
Cells(Num; 2).HorizontalAlignment = xlCenter
Cells(Num; 3).HorizontalAlignment = xlCenter
Cells(Num; 3).WrapText = True
Num = Num + 1
End If
Next i
Cells(2; 1) = "за период от " + CStr(DateBegin) + " до " + CStr(DateEnd)
Range(Cells(5; 1); Cells(Num - 1; 3)).Borders(xlLeft).Weight = xlThin
Range(Cells(5; 1); Cells(Num - 1; 3)).Borders(xlRight).Weight = xlThin
Range(Cells(5; 1); Cells(Num - 1; 3)).Borders(xlTop).Weight = xlThin
Range(Cells(5; 1); Cells(Num - 1; 3)).Borders(xlBottom).Weight = xlThin
Range(Cells(5; 1); Cells(Num - 1; 3)).BorderAround Weight:=xlMedium
Range(Cells(5; 2); Cells(Num - 1; 2)).BorderAround Weight:=xlMedium
Cells(Num + 2; 2) = "Ответственное лицо Дилера______________________________"
With DialogSheets("ДиалогПечать")
AgainMonthOtch1:
Просмотр = False
ExitVar = False
Button = False
.Show
If Просмотр Then
Worksheets("СписокКлиентов").PrintPreview
GoTo AgainMonthOtch1
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)
содержание ..
5
6
7 ..