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