Dim CpuntVigr
sub Init_Components
with self
 .Left = 233
 .Top = 141
 .BorderStyle = "bsDialog"
 .Caption = "   Excel"
 .ClientHeight = 110
 .ClientWidth = 291
 .Color = "clBtnFace"
 .Font.Charset = 204
 .Font.Color = "clWindowText"
 .Font.Height = -11
 .Font.Name = "MS Sans Serif"
 .Font.Style = ""
 .OldCreateOrder = False
 .PixelsPerInch = 96
 self.add "Panel1", "TPanel"
 with Panel1
  .Left = 0
  .Top = 75
  .Width = 271
  .Height = 35
  .Align = "alBottom"
  .BevelInner = "bvRaised"
  .BevelOuter = "bvLowered"
  .TabOrder = 0
  Panel1.add "BitBtn1", "TBitBtn",TRUE
 with BitBtn1
   .Left = 184
   .Top = 5
   .Width = 81
   .Height = 25
   .Caption = ""
   .TabOrder = 0
   .Kind = "bkCancel"
   end with
  Panel1.add "OKBtn", "TBitBtn",TRUE
 with OKBtn
   .Left = 104
   .Top = 5
   .Width = 73
   .Height = 25
   .TabOrder = 1
   .Caption="OK"
   .Kind="bkOk"
   end with
  end with
 self.add "GroupBox1", "TGroupBox"
 with GroupBox1
  .Left = 0
  .Top = 0
  .Width = 271
  .Height = 75
  .Align = "alClient"
  .Caption = ""
  .Font.Charset = 204
  .Font.Color = "clWindowText"
  .Font.Height = -11
  .Font.Name = "MS Sans Serif"
  .Font.Style = "fsBold"
  .ParentFont = False
  .TabOrder = 1
  GroupBox1.add "Label1", "TLabel"
 with Label1
   .Left = 24
   .Top = 22
   .Width = 133
   .Height = 13
   .Caption = "  "
   .Font.Charset = 204
   .Font.Color = "clWindowText"
   .Font.Height = -11
   .Font.Name = "MS Sans Serif"
   .Font.Style = ""
   .ParentFont = False
   end with
  GroupBox1.add "Label2", "TLabel"
 with Label2
   .Left = 14
   .Top = 49
   .Width = 151
   .Height = 13
   .Caption = "  "
   .Font.Charset = 204
   .Font.Color = "clWindowText"
   .Font.Height = -11
   .Font.Name = "MS Sans Serif"
   .Font.Style = ""
   .ParentFont = False
   end with
  GroupBox1.add "BegDate", "TDBDateTimeEditEh"
 with BegDate
   .Left = 169
   .Top = 21
   .Width = 97
   .Height = 19
   .Flat = True
   .Kind = "dtkDateEh"
   .TabOrder = 0
   .Visible = True
   .EditButton.Style="ebsEllipsisEh"
   end with
  GroupBox1.add "EndDate", "TDBDateTimeEditEh"
 with EndDate
   .Left = 170
   .Top = 46
   .Width = 95
   .Height = 19
   .Flat = True
   .Kind = "dtkDateEh"
   .TabOrder = 1
   .EditButton.Style="ebsEllipsisEh"
   .Visible = True
   end with
  end with
 end with
end sub
'******************************************************************************
'  
'******************************************************************************
Dim pos
pos=0
dateVyp = date()
pDate = date()
dim Cell1
dim Sheet
dim app
Dim Database
'******************************************************************************
'Helper 
'******************************************************************************
sub zz ()
  Cell1.Font.Bold = TRUE
end sub

sub FillCellNew(Col, S)
  pos = pos + 1
 set Cell1 = Sheet.Cells(pos, Col)
  Cell1.Value = S
end sub

sub FillCell(Col, S, F)
  set Cell1 = Sheet.Cells(pos, Col)
  if(IsNull(F)<>true) then
   Cell1.Font.ColorIndex = F
  end if
  Cell1.Value = S
end sub
'******************************************************************************

'  
Sub connect ()
set Database=MainForm.Controls("Database")
Self.Add "Trans","TIBTransaction"
Trans.DefaultDatabase=Database
Self.Add "Query", "TIBQuery"
  With Query
    .Database=DataBase
    .SQL.Clear
    .SQL.Add "select * from  vipiska v, fullvipiska f where v.idvip=f.idvip order by datvip, v.idvip,acc"
  End With

 Self.Add "QueryAcc", "TIBQuery"
  With QueryAcc
    .Database=DataBase
    .SQL.Clear
    .SQL.Add "select accnumber,valcode, f.valfull,f.valshort from firmsaccounts f where idcontr=-1"
  End With

end sub

sub PrintShapka (verh)
if(verh=1) then
s=" " & QueryAcc.FieldByNamestring("accnumber") & "  " & QueryACC.Fieldbynamestring("valshort")& ":" & QueryaCC.Fieldbynamestring("valfull")
call FillCellNew(1, s): zz
s=" :"
call FillCellnew(1, s): zz
s=Query.FieldByNameString("ammin")
if(s="") then 
s=""
end if
call FillCell(3, s,null)
end if
' 
if(verh=0) then
s=" :"
call FillCellnew(1, s): zz
s=Query.FieldByNameString("ammout")
if(s="") then 
s=""
end if
call FillCell(3,s,null)
end if

end sub

sub MakeOfOneAccount ()
Dim s
s="select * from  vipiska v where v.acc='" & QueryAcc.FieldByNamestring("accnumber") & "'"
s=s & " and v.valcode='" & QueryAcc.FieldByNamestring("valcode")
s=s & "' and v.datvip>'" & CStr(BegDate.Value-1) & "' and v.datvip<'" & CStr(EndDate.Value) & "'  order by datvip, v.idvip,acc"
Query.Sql.Clear
Query.Sql.Add (s)
'MsgBox s
Query.Active=true
call PrintShapka(1)
Query.Active=false
' 
s="select * from  vipiska v, fullvipiska f where v.idvip=f.idvip and v.acc=f.payeracc and v.acc='" & QueryAcc.FieldByNamestring("accnumber") & "'"
s=s & " and v.valcode='" & QueryAcc.FieldByNamestring("valcode")
s=s & "' and v.datvip>'" & CStr(BegDate.Value-1) & "' and v.datvip<'" & CStr(EndDate.Value) & "'  order by datvip, v.idvip,acc"

Query.Sql.Clear
Query.Sql.Add (s)
Query.Active=true
do while not Query.Eof
call FillCellnew(1, Query.FieldByNaMESTRING("DATVIP"))
s=Query.FieldByNameString("SUM")

call FillCell(2, CDbl(Query.FieldByNameString("SUM")),3)
call FillCell(3, Query.FieldByNameString("ground"),null)

 Query.Next
CountVigr=CountVigr+1
self.Caption= ": " & QueryAcc.FieldByNamestring("accnumber") & " : " & CountVigr
Query.processing
loop
' 
s="select * from  vipiska v, fullvipiska f where v.idvip=f.idvip and v.acc<>f.payeracc and v.acc='" & QueryAcc.FieldByNamestring("accnumber") & "'"
s=s & " and v.valcode='" & QueryAcc.FieldByNamestring("valcode")
s=s & "' and v.datvip>'" & CStr(BegDate.Value-1) & "' and v.datvip<'" & CStr(EndDate.Value) & "'  order by datvip, v.idvip,acc"

Query.Sql.Clear
Query.Sql.Add (s)
Query.Active=true
do while not Query.Eof
   call FillCellnew(1, Query.FieldByNaMESTRING("DATVIP"))
   s="-" & Query.FieldByNameString("SUM")
   call FillCell(2, CDbl(s) ,5)
   call FillCell(3, Query.FieldByNameString("ground"),null)
   Query.Next
CountVigr=CountVigr+1

self.Caption= ": " & QueryAcc.FieldByNamestring("accnumber") & " : "  & CountVigr
Query.processing
loop
'  
call PrintShapka (0)
end sub


sub MakeAll ()
  QueryAcc.Active=true
  do while not QueryAcc.Eof
  call MakeOfOneAccount()
  QueryAcc.Next
  loop
 end sub

' Cancel
sub BitBtn1_onClick
self.Close
end sub

 '  OK
sub OKBtn_onClick
if (IsNull(BegDate.Value)=true) then
 MsgBox "   ",0," BARS"
exit sub
end if

if (IsNull(EndDate.Value)=true) then
 MsgBox "   ",0," BARS"
exit sub
end if

call connect ()
set app = CreateObject("Excel.Application")
if(app.WorkBooks.Count = 0) then
  app.WorkBooks.Add
end if
set Sheet = app.Sheets(1)
app.Sheets(1).Columns("C:C").ColumnWidth = 12
app.Sheets(1).Columns("A:A").ColumnWidth = 10
app.Sheets(1).Columns("B:B").ColumnWidth = 13
app.Sheets(1).Columns("D:D").ColumnWidth = 13
app.Sheets(1).Columns("E:E").ColumnWidth = 13

   s=" : " & Date
  call FillCellnew(1, s):zz
  call FillCellNew (1, "  "):zz
  call FillCellNew(1, " :"): zz
  call FillCell(3,CStr(BegDate.Value),NULL): zz
  call FillCellNew(1, " :"): zz
  call FillCell(3, CStr(EndDate.Value),null): zz
  call MakeAll ()
  app.Visible = TRUE
  self.Close()


end sub


' 
sub main ()
CountVigr=0
call Init_Components()
'self.Visible=true
end sub
