End If
End If
End If
Next k
End If
i = i + 1
Wend
Set Sheet = Worksheets("Сделки")
Worksheets("Журнал лицевого учета").Select
Cells(5; 1) = CurDate
Cells(49; 2) = ComBirga
Покупка = False
Продажа = False
Vol = 0
sum = 0
For k = 1 To BumNum
If BumIndex(k) Then
m = 7
Range("A7:C43").ClearContents
Range("E7:G43").ClearContents
Vol = 0
sum = 0
For i = BeginIndex(k) To dates(k)
If Volume(k; i) > 0 Then
Cells(m; 1) = DateMas(k; i)
Cells(m; 2) = Volume(k; i)
Cells(m; 3) = Format(Price(k; i); "0,00")
Vol = Vol + Volume(k; i)
sum = sum + Format(Price(k; i); "0,00") * Volume(k; i) * 10
m = m + 1
End If
Next i
Cells(6; 2) = Vol
Cells(6; 4) = sum
Cells(49; 3) = ComMas(k)
Cells(5; 3) = CStr(Bum(k)) + "MFTS"
i = 2
m1 = 7
j = BeginIndex(k)
While Sheet.Cells(i; 1) <> Empty
If Sheet.Cells(i; 1) = CurDate And Sheet.Cells(i; 3) = Bum(k) And _
Sheet.Cells(i; 7) <> "зачисление" And Sheet.Cells(i; 7) <> "списание" And _
Sheet.Cells(i; 2) = DilerConst Then
If Not IsEmpty(Sheet.Cells(i; 4)) Then
Покупка = True
Cells(m; 1) = Sheet.Cells(i; 1)
Cells(m; 2) = Sheet.Cells(i; 6)
Cells(m; 3) = Sheet.Cells(i; 4)
Volume(k; dates(k)) = Sheet.Cells(i; 6)
Price(k; dates(k)) = Sheet.Cells(i; 4)
DateMas(k; dates(k)) = Sheet.Cells(i; 4)
dates(k) = dates(k) + 1
m = m + 1
Else
Продажа = True
Vol = Sheet.Cells(i; 6)
If Vol < Volume(k; j) Then
Cells(m1; 5) = Vol
Cells(m1; 6) = Format(Price(k; j); "0,00")
Cells(m1; 7) = Sheet.Cells(i; 5)
Volume(k; j) = Volume(k; j) - Sheet.Cells(i; 6)
m1 = m1 + 1
Else
If Volume(k; j) = 0 Then j = j + 1
While Vol > Volume(k; j) And Volume(k; j) <> Empty
Cells(m1; 5) = Volume(k; j)
Cells(m1; 6) = Format(Price(k; j); "0,00")
Cells(m1; 7) = Sheet.Cells(i; 5)
Vol = Vol - Volume(k; j)
j = j + 1
m1 = m1 + 1
Wend
If Volume(k; j) <> Empty Then
Cells(m1; 5) = Vol
Cells(m1; 6) = Format(Price(k; j); "0,00")
Cells(m1; 7) = Sheet.Cells(i; 5)
Volume(k; j) = Volume(k; j) - Vol
m1 = m1 + 1
End If
End If
End If
End If
i = i + 1
Wend
no_do:
MagMas(k; 1) = Format(Cells(46; 3); "0,00")
MagMas(k; 2) = Format(Cells(47; 3); "0,00")
MagMas(k; 3) = Format(Cells(48; 3); "0,00")
MagMas(k; 4) = Format(Cells(45; 4); "0,00")
If DialogPrint("Журнал лицевого учета"; 1) Then Exit Sub
End If
Next k
' Формирование журнала оборотов
Worksheets("ЖурналОборотов").Select
Cells(6; 1) = CurDate
Range(Cells(7; 1); Cells(100; 6)).Delete shift:=xlToLeft
m = 7
For k = 1 To BumNum
If BumIndex(k) Then
Cells(m; 1) = CStr(Bum(k)) + "MFTS"
Cells(m; 2) = MagMas(k; 1)
Cells(m; 3) = MagMas(k; 2)
Cells(m; 4) = MagMas(k; 3)
Cells(m; 5) = MagMas(k; 4)
Cells(m; 6) = ComMas(k)
Cells(m; 1).Font.Bold = True
Cells(m; 2).NumberFormat = "0,00"
Cells(m; 3).NumberFormat = "0,00"
Cells(m; 4).NumberFormat = "0,00"
Cells(m; 5).NumberFormat = "0,00"
Cells(m; 6).NumberFormat = "0,00"
m = m + 1
End If
Next k
For i = 2 To 6
sum = 0
For m1 = 7 To m - 1
sum = sum + Cells(m1; i)
Next m1
Cells(m; i) = sum
Cells(m; i).NumberFormat = "0,00"
Next i
Mag(1) = Cells(m; 2)
Mag(2) = Cells(m; 3)
Mag(3) = Cells(m; 4)
Mag(4) = Cells(m; 6)
If Cells(m; 2) > 0 Then Cells(m + 1; 2) = "Дт" + S192
If Cells(m; 2) < 0 Then Cells(m + 1; 2) = "Кт" + S192
If Cells(m; 3) > 0 Then Cells(m + 1; 3) = "Дт" + S904
If Cells(m; 3) < 0 Then Cells(m + 1; 3) = "Кт" + S904
If Cells(m; 4) > 0 Then Cells(m + 1; 4) = "Кт" + S960
If Cells(m; 4) < 0 Then Cells(m + 1; 4) = "Дт" + S970
Cells(m + 1; 6) = "Дт" + S970
Range(Cells(m + 1; 2); Cells(m + 2; 6)).HorizontalAlignment = xlCenter
Range(Cells(m + 1; 1); Cells(m + 1; 6)).Interior.ColorIndex = 15
Cells(m + 2; 6) = "Кт" + S904
Cells(m + 2; 6).Interior.ColorIndex = 15
Range(Cells(7; 1); Cells(m - 1; 6)).Borders(xlRight).Weight = xlThin
Range(Cells(m; 1); Cells(m; 6)).Borders(xlRight).LineStyle = xlDouble
Range(Cells(m; 1); Cells(m; 6)).Borders(xlLeft).LineStyle = xlDouble
Range(Cells(m; 1); Cells(m; 6)).Borders(xlTop).LineStyle = xlDouble
Range(Cells(m; 1); Cells(m; 6)).Borders(xlBottom).LineStyle = xlDouble
Cells(m + 2; 4) = "Подпись ответственного"
Cells(m + 3; 4) = "сотрудника"
Range(Cells(m + 2; 4); Cells(m + 3; 4)).Font.Size = 8
Range(Cells(m + 2; 4); Cells(m + 3; 4)).HorizontalAlignment = xlLeft
Range(Cells(7; 1); Cells(m + 4; 6)).BorderAround Weight:=xlMedium
Range(Cells(m + 2; 3); Cells(m + 4; 3)).Borders(xlRight).Weight = xlThin
Range(Cells(m + 1; 1); Cells(m + 1; 5)).Borders(xlBottom).Weight = xlThin
Cells(m + 2; 6).Borders(xlLeft).Weight = xlThin
Cells(m + 2; 6).Borders(xlBottom).Weight = xlThin
If DialogPrint("ЖурналОборотов"; 1) Then Exit Sub
' печать мемориального ордера
Dim StrS As String
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 = "Покупка / Погашение"
End With
Worksheets("Ордер").Select
i = CInt(InputBox("Введите номер 1-го ордера"))
If Mag(1) > 0 Then
If Mag(2) < 0 Then
If MemoOrder(i; min(Mag(1); Mag(2)); S192; S904; 0; _
StrS + " РКО за " + CStr(CurDate)) Then Exit Sub
i = i + 1
End If
If Mag(3) > 0 Then
If MemoOrder(i; min(Mag(1); Mag(3)); S192; S960; 0; _
"Доход от продажи РКО за " + CStr(CurDate)) Then Exit Sub
i = i + 1
End If
End If
If Mag(2) > 0 Then
If Mag(1) < 0 Then
If MemoOrder(i; min(Mag(2); Mag(1)); S904; S192; 0; _
StrS + " РКО за " + CStr(CurDate)) Then Exit Sub
i = i + 1
End If
If Mag(3) > 0 Then
If MemoOrder(i; min(Mag(2); Mag(3)); S904; S960; 0; _
"Доход от продажи РКО за " + CStr(CurDate)) Then Exit Sub
i = i + 1
End If
End If
If Mag(3) < 0 Then
If Mag(1) < 0 Then
If MemoOrder(i; min(Mag(3); Mag(1)); SR970; S192; 0; _
"Отрицательная разница от продажи РКО за " + CStr(CurDate)) Then Exit Sub
i = i + 1
End If
If Mag(2) < 0 Then
If MemoOrder(i; min(Mag(3); Mag(2)); SR970; S904; 0; _
"Отрицательная разница от продажи РКО за " + CStr(CurDate)) Then Exit Sub
i = i + 1
End If
End If
If Format(Mag(4)) > 0 Then
If MemoOrder(i; Mag(4); S970; S904; 0; _
"Комиссия ВКБ в т.ч. НДС " + CStr(Format(Mag(4) / 6; "0,00"))) Then Exit Sub
End If
End Sub
'-------------------------------------------- Memo Order
Function MemoOrder(Num; sum As Double; n1; n2; Pos As Integer; Order As String)
Dim i As Integer
Dim Flag As Boolean
Dim Str; Str1 As String
Str1 = ""
Str = CStr(sum)
Str = Format(Str; "000000000000,00")
Flag = False
For i = 1 To Len(Str)
If Mid(Str; i; 1) = "," Then
If CInt(Right(Str; 2)) = 0 Then
Str1 = Str1 + "="
Exit For
Else
Str1 = Str1 + "-"
End If
Else
If Mid(Str; i; 1) <> "0" Then Flag = True
If Mid(Str; i; 1) <> "0" Or Flag Then Str1 = Str1 + Mid(Str; i; 1)
End If
Next i
Cells(3; 6) = Str1
If Pos > 0 Then
If n1 > 6 Then
Cells(5; 6) = Worksheets("Клиенты").Cells(2; n1)
Else
Cells(5; 6) = Worksheets("Клиенты").Cells(Pos; n1)
End If
If n2 > 6 Then
Cells(10; 6) = Worksheets("Клиенты").Cells(2; n2)
Else
Cells(10; 6) = Worksheets("Клиенты").Cells(Pos; n2)
End If
Else
Cells(5; 6) = n1
Cells(10; 6) = n2
End If
Cells(16; 1) = Order
Cells(1; 6) = Num
Range("A1:H24").Copy
Range("A32").Select
ActiveSheet.Paste
If DialogPrint("Ордер"; 2) Then
MemoOrder = True
Else
MemoOrder = False
End If
End Function
'-------------------------------- Печать биржевой информации -------
Sub PrintBirgaInfo()
Dim Sheet As Object
Dim Flag As Boolean
Dim i; n; k; Num As Long
Dim mas(3) As Double
Set Sheet = Worksheets("Биржа")
CurDate = Worksheets("Врем").Cells(1; 4)
Sheets("Биржевая Информация").Select
Cells(3; 10) = CurDate
For i = 1 To 3
mas(i) = 0
Next i
i = 2
n = 7
Range(Cells(n; 1); Cells(n + 100; 17)).Delete shift:=xlToLeft
Flag = True
Do While Sheet.Cells(i; 1) <> Empty
If Sheet.Cells(i; 1) = CurDate Then
Flag = False
Cells(n; 1) = Sheet.Cells(i; 2)
Cells(n; 7) = Sheet.Cells(i; 3)
Cells(n; 9) = Sheet.Cells(i; 4)
Cells(n; 10) = Sheet.Cells(i; 5)
Cells(n; 5).Font.Bold = True
Cells(n; 11) = Sheet.Cells(i; 6)
Cells(n; 11).Font.Bold = True
Cells(n; 12) = Sheet.Cells(i; 7)
Cells(n; 13) = Sheet.Cells(i; 8)
k = 2
While Worksheets("Бумаги").Cells(k; 1) <> Empty
If Worksheets("Бумаги").Cells(k; 1) = Cells(n; 1) Then
Cells(n; 2) = Worksheets("Бумаги").Cells(k; 2)
Cells(n; 3) = Worksheets("Бумаги").Cells(k; 3)
Cells(n; 6) = Worksheets("Бумаги").Cells(k; 4)
End If
k = k + 1
Wend
Cells(n; 2).NumberFormat = "ДД.ММ.ГГ"
Cells(n; 3).NumberFormat = "ДД.ММ.ГГ"
Cells(n; 6).NumberFormat = "# ##0"
Cells(n; 9).NumberFormat = "# ##0"
Range(Cells(n; 10); Cells(n; 17)).NumberFormat = "0,00"
Cells(n; 4) = Cells(3; 10) - Cells(n; 2)
Cells(n; 5) = Cells(n; 3) - Cells(3; 10)
Cells(n; 8) = Cells(n; 9) / Cells(n; 6) * 100
Cells(n; 8).NumberFormat = "0,00"
If Cells(n; 7) <> 0 And Cells(n; 5) <> 0 Then
Cells(n; 14) = (100 / Cells(n; 10) - 1) * 36500 / Cells(n; 5) * 0,85
Cells(n; 15) = (100 / Cells(n; 10) - 1) * 36500 / Cells(n; 5)
Cells(n; 16) = (100 / Cells(n; 11) - 1) * 36500 / Cells(n; 5) * 0,85
Cells(n; 16).Font.Bold = True
Cells(n; 17) = (100 / Cells(n; 11) - 1) * 36500 / Cells(n; 5)
mas(1) = mas(1) + Cells(n; 5) * Cells(n; 9) * Cells(n; 14)
mas(2) = mas(2) + Cells(n; 5) * Cells(n; 9) * Cells(n; 16)
mas(3) = mas(3) + Cells(n; 5) * Cells(n; 9)
End If
n = n + 1
End If
i = i + 1
Loop
If Flag Then
MsgBox "Биржевой информации нет"
Exit Sub
End If
Num = n
Range(Cells(7; 1); Cells(Num - 1; 17)).Borders(xlLeft).Weight = xlThin
Range(Cells(7; 1); Cells(Num - 1; 17)).Borders(xlRight).Weight = xlThin
Range(Cells(7; 1); Cells(Num - 1; 17)).Borders(xlTop).Weight = xlThin
Range(Cells(7; 1); Cells(Num - 1; 17)).Borders(xlBottom).Weight = xlThin
Range(Cells(7; 1); Cells(Num - 1; 17)).BorderAround Weight:=xlMedium
Cells(Num; 1) = "Итого"
Cells(Num; 1).Font.Bold = True
Cells(Num; 1).HorizontalAlignment = xlCenter
Cells(Num; 14) = mas(1) / mas(3)
Cells(Num; 15) = mas(1) / mas(3) / 0,85
Cells(Num; 16) = mas(2) / mas(3)
Cells(Num; 16).Font.Bold = True
Cells(Num; 17) = mas(2) / mas(3) / 0,85
Range(Cells(Num; 14); Cells(Num; 17)).NumberFormat = "0,00"
For i = 1 To 3
mas(i) = 0
Next i
For i = 7 To Num - 1
mas(1) = mas(1) + Cells(i; 6)
mas(2) = mas(2) + Cells(i; 7)
mas(3) = mas(3) + Cells(i; 9)
Next
Cells(Num; 6) = mas(1)
Cells(Num; 6).NumberFormat = "# ##0"
Cells(Num; 7) = mas(2)
Cells(Num; 9) = mas(3)
Cells(Num; 9).NumberFormat = "# ##0"
Cells(Num; 8) = mas(3) / mas(1) * 100
Cells(Num; 8).NumberFormat = "0,00"
Cells(Num; 7).Font.Bold = True
Cells(Num; 9).Font.Bold = True
Range(Cells(Num; 1); Cells(Num; 17)).BorderAround Weight:=xlMedium
Range(Cells(Num; 1); Cells(Num; 17)).Interior.ColorIndex = 15
If DialogPrint("Биржевая Информация"; 1) Then Exit Sub
End Sub
'-------------------------------- Дата -----------------------------
Sub DateChange()
With DialogSheets("ДиалогДата")
.EditBoxes.Text = CurDate
.EditBoxes.InputType = 1
.Show
CurDate = Worksheets("Врем").Cells(1; 4)
If Button = False Then
CurDate = Date
Worksheets("Врем").Cells(1; 4) = CurDate
MsgBox "Дата восстановлена"
Else
If IsDate(.EditBoxes.Text) Then
CurDate = .EditBoxes.Text
MsgBox "Дата изменена"
Worksheets("Врем").Cells(1; 4) = CurDate
Exit Sub
End If
MsgBox "Ошибка при вводе даты"
End If
End With
End Sub
'-------------------------------- Формирование текущей таблицы бумаг ----
Sub FormBum()
Dim L As Object
Dim i; k As Integer
Set L = Worksheets("Бумаги")
CurDate = Worksheets("Врем").Cells(1; 4)
i = 2
k = 1
While L.Cells(i; 1) <> Empty
If L.Cells(i; 2) <= CurDate And L.Cells(i; 3) >= CurDate Then
Worksheets("Врем").Cells(k; 1) = L.Cells(i; 1)
k = k + 1
End If
i = i + 1
Wend
Worksheets("Врем").Cells(1; 2) = k - 1
Set L = Worksheets("Клиенты")
i = 1
While L.Cells(i; 1) <> Empty
i = i + 1
Wend
Worksheets("Врем").Cells(1; 3) = i - 2
End Sub
' ------------------------------- Остатки на бирже --------------------
Sub EditOstBirga(CliNum As Long)
Dim ComBirga; sum; OstBegin As Double
Dim DoFlag As Boolean
Dim Sheet; Sheet1 As Object
Dim i; k; RowNum As Long
Set Sheet = Worksheets("ОстаткиБиржа")
Set Sheet1 = Worksheets("Сделки")
CurDate = Worksheets("Врем").Cells(1; 4)
ComBirga = Worksheets("Инфо").Cells(1; 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
OstBegin = 0
RowNum = 0
k = 2
DoFlag = True
Do While Sheet.Cells(k; 1) <> Empty
If Sheet.Cells(k; 2) = CliNum And DoFlag Then
If Sheet.Cells(k; 1) < CurDate Then
OstBegin = Sheet.Cells(k; 6)
Else
Do While Sheet.Cells(k; 1) <> Empty
If Sheet.Cells(k; 2) <> CliNum Then Exit Do
If Sheet.Cells(k; 1) = CurDate Then