Dim txt
Dim FS
Dim ts

sub Init_Components
with self
 .Left = 233
 .Top = 141
 .BorderStyle = "bsDialog"
 .Caption = "   Excel"
 .ClientHeight = 110
 .ClientWidth = 271
 .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 "Database", "TIBDatabase"
 with Database
   .Params.Add CStr("lc_ctype=WIN1251")
   .Params.Add CStr("user_name=sysdba")
   .Params.Add CStr("password=masterkey")
   .LoginPrompt=false
   .Databasename="d:\bank-client_crypto\source\client\client_200.gdb"
 end with
 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 (TXT=0) then
    if(verh=1) then
               s=" " & QueryAcc.FieldByNamestring("accnumber") & "  " & QueryACC.Fieldbynamestring("valcode")& ":" & 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 if
' 
if (TXT=1) then
    if(verh=1) then
               s=" " & QueryAcc.FieldByNamestring("accnumber") & "  " & QueryACC.Fieldbynamestring("valcode")& ":" & QueryaCC.Fieldbynamestring("valfull")
               ts.WriteLine s
               s1=" :"
               s=Query.FieldByNameString("ammin")
               if(s="") then
               s=""
               end if
               ts.WriteLine s1 & s
    end if
              ' 
   if(verh=0) then
               s1=" :"
               s=Query.FieldByNameString("ammout")
               if(s="") then
               s=""
               end if
               ts.WriteLine s1 & s
   end if

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) & "' and v.datvip<'" & CStr(EndDate.Value+1) & "'  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
if (TXT=1)  then
  s1=Query.FieldByNaMESTRING("DATVIP") & chr(9) & "-"&Query.FieldByNameString("SUM") & chr(9) & Query.FieldByNameString("ground")
  ts.WriteLine s1
end if

if (TXT=0)  then
  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)
end if
 Query.Next
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
   if (TXT=0)  then
     call FillCellnew(1, Query.FieldByNaMESTRING("DATVIP"))
     s="-" & Query.FieldByNameString("SUM")
     call FillCell(2, CDbl(s) ,5)
     call FillCell(3, Query.FieldByNameString("ground"),null)
  end if
  if (TXT=1) then
    s1=Query.FieldByNaMESTRING("DATVIP") & chr(9) & Query.FieldByNameString("SUM") & chr(9) & Query.FieldByNameString("ground")
    ts.WriteLine s1
  end if
   Query.Next
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 ()
if (TXT=0) then
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
end if

if (TXT=1) then

set FS=CreateObject("Scripting.FileSystemObject")
SET ts=FS.OpenTextFile ("c:\1.txt",2,True,0)
s=" : " & Date
ts.WriteLine s
call MakeAll()
ts.Close
SET FS=nothing
end if

set app = CreateObject("Excel.Application")
call app.Workbooks.OpenText("c:\1.TXT",2,True)


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 ()
call Init_Components()
TXT=1
self.Visible=true
end sub
