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 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)
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) *
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)
n = n + 1
i = i + 1
Loop
If Flag Then
MsgBox "Биржевой информации нет"
Exit Sub
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 =
Range(Cells(7; 1); Cells(Num - 1; 17)).Borders(xlTop).Weight = xlThin
Range(Cells(7; 1); Cells(Num - 1; 17)).Borders(xlBottom).Weight =
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 = 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
If Button = False Then
CurDate = Date
Worksheets("Врем").Cells(1; 4) = CurDate
MsgBox "Дата восстановлена"
If IsDate(.EditBoxes.Text) Then
CurDate = .EditBoxes.Text
MsgBox "Дата изменена"
MsgBox "Ошибка при вводе даты"
End With
'-------------------------------- Формирование текущей таблицы бумаг --
--
Sub FormBum()
Dim L As Object
Dim i; k As Integer
Set L = Worksheets("Бумаги")
k = 1
While L.Cells(i; 1) <> Empty
If L.Cells(i; 2) = CurDate Then
Worksheets("Врем").Cells(k; 1) = L.Cells(i; 1)
Worksheets("Врем").Cells(1; 2) = k - 1
Set L = Worksheets("Клиенты")
i = 1
Worksheets("Врем").Cells(1; 3) = i - 2
' ------------------------------- Остатки на бирже --------------------
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("Сделки")
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
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)
If Sheet.Cells(k; 2) <> CliNum Then Exit Do
If Sheet.Cells(k; 1) = CurDate Then
OstBegin = Sheet.Cells(k; 3)
RowNum = k
Exit Do
DoFlag = False
If RowNum = 0 Then RowNum = k
k = RowNum
sum = 0
While Sheet1.Cells(i; 1) <> Empty
If Sheet1.Cells(i; 1) = CurDate And Sheet1.Cells(i; 2) = CliNum Then
If Sheet1.Cells(i; 4) <> Empty Then
sum = sum - _
Sheet1.Cells(i; 4) * Sheet1.Cells(i; 6) * 10000 - _
Format(Sheet1.Cells(i; 4) * Sheet1.Cells(i; 6) * 100 * ComBirga +
0,0001; "0,00")
If Sheet1.Cells(i; 5) = 100 Then ComBirga = 0
sum = sum + _
Sheet1.Cells(i; 5) * Sheet1.Cells(i; 6) * 10000 - _
Format(Sheet1.Cells(i; 5) * Sheet1.Cells(i; 6) * 100 * ComBirga +
Sheet.Cells(k; 3) = OstBegin
Sheet.Cells(k; 6) = OstBegin + sum + Sheet.Cells(k; 4)
Sheet.Cells(k; 1) = CurDate
Sheet.Cells(k; 2) = CliNum
Sub Ok()
Button = True
Sub Cancel()
Button = False
Sub ПросмотрОтчетов()
Просмотр = True
Sub Останов()
ExitVar = True
Sub EndOf()
Dim i As Long
While Cells(i; 1) <> Empty
Cells(i; 1).Select
Function DialogPrint(Str As String; Count As Integer)
With DialogSheets("ДиалогПечать")
AgainView:
Просмотр = False
ExitVar = False
If Просмотр Then
Worksheets(Str).PrintPreview
GoTo AgainView
Страницы: 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20