Банк как субъект привлечения иностранных инвестиций в регион
Страница 9
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)