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)