procedure InitExcel(templName: string);
    begin
        exAppl := CreateOleObject('Excel.Application');
        exAppl.Visible := true;
        exAppl.Application.EnableEvents := false;
        exAppl.DisplayAlerts := false;

        exAppl.Workbooks.Add(templName);
        Sheet := exAppl.Workbooks[ 1 ].WorkSheets[ 1 ];
    end;

    procedure ShowExcel;
    begin
        exAppl.Application.EnableEvents := true;
        exAppl.DisplayAlerts := true;
        exAppl.Visible := true;
    end;

    procedure WriteColumnNow(columnName: string; a1: TStringList; varType: Word; IsInsert: boolean = false);
    var col, row: Integer;
    begin
        try
            if a1.Count >  0  then
                Sheet.Range[columnName + 'Один'] := a1.Strings[ 0 ];
        except end;

        try
            row := Sheet.Range[columnName].Row;
            col := Sheet.Range[columnName].Column;
            if IsInsert and (a1.Count >  1 ) then Sheet.Range[IntToStr(row +  1 ) + ':' + IntToStr(row + a1.Count -  1 )].EntireRow.Insert(xlShiftUp);
            Sheet.Range[xlR1C1ColToA1Col(col) + IntToStr(row), xlR1C1ColToA1Col(col) + IntToStr(row + a1.Count -  1 )] := VarArrayFromStrings(a1, varType);
        except end;
    end;

    procedure WriteCompanyReport;
    var i, j: Integer;
        strList, sss: TStringList;
        ss: TStrings;
        fio: string;
        lOC: string;
    begin
      lOC := frmDM.GetID('select COMPANY_ID from COMPANY_OUR');
        try
            strList := TStringList.Create;
            sss := TStringList.Create;

            InitExcel(templateName);

            for i := Low(TemplHeader[ 0 ]) to High(TemplHeader[ 0 ]) do
                strList.AddObject(TemplHeader[ 0 ][i], TStringList.Create);

            for i :=  0  to tvBook.DataController.GetSelectedCount -  1  do begin
                sss.Add(IntToStr(i +  1 ));
                with tvBook.DataController do
                    if frmDM.qBook2.Locate('MEGA_ID', Values[GetRowInfo(GetSelectedRowIndex(i)).RecordIndex, tvBookMEGA_ID.Index], []) then
                        for j := Low(TemplHeader[ 0 ]) to High(TemplHeader[ 0 ]) do
                            if (TemplHeader[ 0 ][j] = 'АгентИО') or (TemplHeader[ 0 ][j] = 'СтраховательИО') then begin

                                fio := frmDM.qBook2.FieldByName(TemplHeader[ 1 ][j]).AsString;
                                Split(fio, ' ', ss);
                                if ss.Count >  1  then
                                  try
                                    fio := ss.Strings[ 0 ];
                                    fio := fio + ' ' + LeftStr(ss.Strings[ 1 ],  1 );
                                    fio := fio + '.' + LeftStr(ss.Strings[ 2 ],  1 ) + '.';
                                  except
                                  end;
                                FreeAndNil(ss);

                                TStringList(strList.Objects[j]).Add(fio);
                            end else if (TemplHeader[ 0 ][j] = 'НеПолучены') then begin
                                if frmDM.qBook2.FieldByName(TemplHeader[ 1 ][j]).AsString = '1' then TStringList(strList.Objects[j]).Add('не получены')
                                else TStringList(strList.Objects[j]).Add('получены');
                            end else if (TemplHeader[ 0 ][j] = 'Рассрочка') then begin
                                if frmDM.qBook2.FieldByName(TemplHeader[ 1 ][j]).AsString = '1' then TStringList(strList.Objects[j]).Add('да')
                                else TStringList(strList.Objects[j]).Add('нет');
                            end else if (TemplHeader[ 0 ][j] = 'Суб') then begin
                                if frmDM.qBook2.FieldByName(TemplHeader[ 1 ][j]).AsString = '' then TStringList(strList.Objects[j]).Add(lOC)
                                else TStringList(strList.Objects[j]).Add(frmDM.qBook2.FieldByName(TemplHeader[ 1 ][j]).AsString);
                            end else if (TemplHeader[ 0 ][j] = 'ОбщаяСумма') then begin
                                if Length(frmDM.qBook2.FieldByName(TemplHeader[ 1 ][j]).AsString) =  0  then
                                    TStringList(strList.Objects[j]).Add(frmDM.qBook2.FieldByName('Book_SUMMA').AsString)
                                else TStringList(strList.Objects[j]).Add(frmDM.qBook2.FieldByName(TemplHeader[ 1 ][j]).AsString);
                            end else if (TemplHeader[ 0 ][j] = 'СуммаКомпании') then begin
                                TStringList(strList.Objects[j]).Add(IntToStr((frmDM.qBook2.FieldByName('Book_SUMMA').AsInteger - frmDM.qBook2.FieldByName('AGENT_RATE').AsInteger)));
                            end else TStringList(strList.Objects[j]).Add(frmDM.qBook2.FieldByName(TemplHeader[ 1 ][j]).AsString);
            end;

            try Sheet.Range['Шапка'] := Sheet.Range['Шапка'].Value + FormatDateTime('dd.mm.yyyy', cxDateBegin.EditValue) + '-' + FormatDateTime('dd.mm.yyyy', cxDateEnd.EditValue)
            except end;

            WriteColumnNow('Номер', sss, varInteger, true);

            for i := Low(TemplHeader[ 0 ]) to High(TemplHeader[ 0 ]) do begin
                if (TemplHeader[ 0 ][i] = 'НачалоДоговора') or (TemplHeader[ 0 ][i] = 'ОкончаниеДоговора') or
                (TemplHeader[ 0 ][i] = 'ДатаСледующегоПлатежа') or(TemplHeader[ 0 ][i] = 'ОкончаниеПериода') or
                (TemplHeader[ 0 ][i] = 'ДатаПлатежа')
                then
                    WriteColumnNow(TemplHeader[ 0 ][i], TStringList(strList.Objects[i]), varDate)
                else if (TemplHeader[ 0 ][i] = 'СуммаОплаты') or (TemplHeader[ 0 ][i] = 'Комиссия') or
                (TemplHeader[ 0 ][i] = 'ОбщаяСумма') or (TemplHeader[ 0 ][i] = 'СуммаКомпании') or (TemplHeader[ 0 ][i] = 'Стоимость') then
                    WriteColumnNow(TemplHeader[ 0 ][i], TStringList(strList.Objects[i]), varCurrency)
                else if (TemplHeader[ 0 ][i] = 'Год') then
                    WriteColumnNow(TemplHeader[ 0 ][i], TStringList(strList.Objects[i]), varInteger)
                else WriteColumnNow(TemplHeader[ 0 ][i], TStringList(strList.Objects[i]), varOleStr);
            end;

            ShowExcel;
        finally
            for i := Low(TemplHeader[ 0 ]) to High(TemplHeader[ 0 ]) do
                TStringList(strList.Objects[i]).Free;
            FreeAndNil(strList);
        end;
    end;

    function IsOLEObjectInstalled(Name: String): boolean;
    var ClassID: TCLSID;
        Rez : HRESULT;
    begin
        Rez := CLSIDFromProgID(PWideChar(WideString(Name)), ClassID);
        if Rez = S_OK then Result := true
        else Result := false;
    end;

begin
    if not IsOLEObjectInstalled('Excel.Application') then begin
        ShowMessage('Excel не установлен! Работа программы невозможна!');
        exit;
    end;
    exAppl := Unassigned;
    Sheet := Unassigned;