VPF::Экспорт DbGrid в Exel - Форум программистов

bartram

Дата 7.8.2005, 19:49 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Комодератор
Сообщений: 1606
Регистрация: 22.2.2004
Где: Russia, Samara

Репутация: нет
Всего: 29

Сабж! Есть код:

Код


unit DBGridExportToExcel;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls, ComCtrls, DB, IniFiles, Buttons, dbgrids, ADOX_TLB, ADODB;


type TScrollEvents = class
       BeforeScroll_Event: TDataSetNotifyEvent;
       AfterScroll_Event: TDataSetNotifyEvent;
       AutoCalcFields_Property: Boolean;
  end;

procedure DisableDependencies(DataSet: TDataSet; var ScrollEvents: TScrollEvents);
procedure EnableDependencies(DataSet: TDataSet; ScrollEvents: TScrollEvents);
procedure DBGridToExcelADO(DBGrid: TDBGrid; FileName: string; SheetName: string);


implementation

//Support procedures: I made that in order to increase speed in
//the process of scanning large amounts
//of records in a dataset

//we make a call to the "DisableControls" procedure and then disable the "BeforeScroll" and
//"AfterScroll" events and the "AutoCalcFields" property.
procedure DisableDependencies(DataSet: TDataSet; var ScrollEvents: TScrollEvents);
begin
  with DataSet do
    begin
      DisableControls;
      ScrollEvents := TScrollEvents.Create();
      with ScrollEvents do
        begin
          BeforeScroll_Event := BeforeScroll;
          AfterScroll_Event := AfterScroll;
          AutoCalcFields_Property := AutoCalcFields;
          BeforeScroll := nil;
          AfterScroll := nil;
          AutoCalcFields := False;
        end;
    end;
end;

//we make a call to the "EnableControls" procedure and then restore
// the "BeforeScroll" and "AfterScroll" events and the "AutoCalcFields" property.

procedure EnableDependencies(DataSet: TDataSet; ScrollEvents: TScrollEvents);
begin
  with DataSet do
    begin
      EnableControls;
      with ScrollEvents do
        begin
          BeforeScroll := BeforeScroll_Event;
          AfterScroll := AfterScroll_Event;
          AutoCalcFields := AutoCalcFields_Property;
        end;
    end;
end;

//This is the procedure which make the work:

procedure DBGridToExcelADO(DBGrid: TDBGrid; FileName: string; SheetName: string);
var
  cat: _Catalog;
  tbl: _Table;
  col: _Column;
  i: integer;
  ADOConnection: TADOConnection;
  ADOQuery: TADOQuery;
  ScrollEvents: TScrollEvents;
  SavePlace: TBookmark;
begin
  //
  //WorkBook creation (database)
  cat := CoCatalog.Create;
  cat._Set_ActiveConnection('Provider=Microsoft.Jet.OLEDB.4.0; Data Source=' + FileName + ';Extended Properties=Excel 8.0');
  //WorkSheet creation (table)
  tbl := CoTable.Create;
  tbl.Set_Name(SheetName);
  //Columns creation (fields)
  DBGrid.DataSource.DataSet.First;
  with DBGrid.Columns do
    begin
      for i := 0 to Count - 1 do
        if Items[i].Visible then
        begin
          col := nil;
          col := CoColumn.Create;
          with col do
            begin
              Set_Name(Items[i].Title.Caption);
              Set_Type_(adVarWChar);
            end;
          //add column to table
          tbl.Columns.Append(col, adVarWChar, 20);
        end;
    end;
  //add table to database
  cat.Tables.Append(tbl);

  col := nil;
  tbl := nil;
  cat := nil;

  //exporting
  ADOConnection := TADOConnection.Create(nil);
  ADOConnection.LoginPrompt := False;
  ADOConnection.ConnectionString := 'Provider=Microsoft.Jet.OLEDB.4.0; Data Source=' + FileName + ';Extended Properties=Excel 8.0';
  ADOQuery := TADOQuery.Create(nil);
  ADOQuery.Connection := ADOConnection;
  ADOQuery.SQL.Text := 'Select * from [' + SheetName + '$]';
  ADOQuery.Open;


  DisableDependencies(DBGrid.DataSource.DataSet, ScrollEvents);
  SavePlace := DBGrid.DataSource.DataSet.GetBookmark;
  try
  with DBGrid.DataSource.DataSet do
    begin
      First;
      while not Eof do
        begin
          ADOQuery.Append;
          with DBGrid.Columns do
            begin
              ADOQuery.Edit;
              for i := 0 to Count - 1 do
                if Items[i].Visible then
                  begin
                    ADOQuery.FieldByName(Items[i].Title.Caption).AsString := FieldByName(Items[i].FieldName).AsString;
                  end;
              ADOQuery.Post;
            end;
          Next;
        end;
    end;

  finally
  DBGrid.DataSource.DataSet.GotoBookmark(SavePlace);
  DBGrid.DataSource.DataSet.FreeBookmark(SavePlace);
  EnableDependencies(DBGrid.DataSource.DataSet, ScrollEvents);

  ADOQuery.Close;
  ADOConnection.Close;

  ADOQuery.Free;
  ADOConnection.Free;

  end;

end;

end.

Выполнил все инструкции которые указаны

Код


{  
  Exporting a DBGrid to excel without OLE  

  I develop software and about 95% of my work deals with databases.  
  I enjoied the advantages of using Microsoft Excel in my projects  
  in order to make reports but recently I decided to convert myself  
  to the free OpenOffice suite.  
  I faced with the problem of exporting data to Excel without having  
  Office installed on my computer.  
  The first solution was to create directly an Excel format compatible file:  
  this solution is about 50 times faster than the OLE solution but there  
  is a problem: the output file is not compatible with OpenOffice.  
  I wanted a solution which was compatible with each "DataSet";  
  at the same time I wanted to export only the dataset data present in  
  a DBGrid and not all the "DataSet".  
  Finally I obtained this solution which satisfied my requirements.  
  I hope that it will be usefull for you too.  

  First of all you must import the ADOX type library  
  which will be used to create the Excel file and its  
  internal structure: in the Delphi IDE:  

  1)Project->Import Type Library:  
  2)Select "Microsoft ADO Ext. for DDL and Security"  
  3)Uncheck "Generate component wrapper" at the bottom  
  4)Rename the class names (TTable, TColumn, TIndex, TKey, TGroup, TUser, TCatalog) in  
    (TXTable, TXColumn, TXIndex, TXKey, TXGroup, TXUser, TXCatalog)  
    in order to avoid conflicts with the already present TTable component.  
  5)Select the Unit dir name and press "Create Unit".  
    It will be created a file named AOX_TLB.  
    Include ADOX_TLB in the "uses" directive inside the file in which you want  
    to use ADOX functionality.  

  That is all. Let's go now with the implementation:  
}

И при компиляции Ошибка:

Цитата

[Ошибка] DBGridExportToExcel.pas(80): Incompatible types: 'String' and 'IDispatch'

Помогите пожалуйста разобраться smile

Это сообщение отредактировал(а) bartram - 7.8.2005, 19:50

--------------------

В каждом из нас спит гений, но с каждым днем все крепче ;-)
bartram.ru
Twitter
user posted image

Grig

Дата 8.8.2005, 03:12 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 809
Регистрация: 29.4.2005
Где: Иркутск

Репутация: 4
Всего: 16

Я с тем примером тоже, кстати, запарился..
На данный момент делаю так:

Код


var _txt,_txt1:string;
    Cell1,Cell2,ArrayData,ArrayColor:variant;
    BeginCol,BeginRow,i:integer;
    ColCount,RowCount:integer;
    oleApp:Variant;

    _Sheets:integer;
label 1;
begin
RowCount:=ADOTable1.RecordCount;//считаешь количество строк
ColCount:=8;//сколько столбцов будет в EXCEL-таблице
     oleApp:=CreateOleObject('Excel.Application');
     oleApp.WorkBooks.Add();
     _txt:='c:\export.xls';
     oleApp.ActiveWorkBook.SaveAs(_txt);
     oleApp.Workbooks.Open(_txt);
    // заполнение таблицы EXCEL - по листам
     oleApp.WorkSheets[1].Select;
     oleApp.WorkSheets[1].Name:='Лист данных из Дельфи';

   ArrayColor:=VarArrayCreate([1,RowCount,1,2],varVariant);
     ArrayData:=VarArrayCreate([1,RowCount,1,ColCount],varVariant);
ADOTable1.First;//твоя таблица
    For i:=1 to RowCount do
         begin
       if ADOTable1.FieldValues['tovar']='Ватрушки' then{Это для разукраски таблицы, если понадобится конечно}
           begin
             ArrayColor[i,1]:=i;
             ArrayColor[i,2]:=1;
           end;

           ArrayData[i,1]:=ADOTable1.FieldByName('Field1').AsString;
           ArrayData[i,2]:=ADOTable1.FieldByName('Field2').AsString;
           //......
           ArrayData[i,8]:=ADOTable1.FieldByName('Field8').AsString;
            ADOTable1.Next;
        end;
     BeginCol:=1;   //с какого столбца
     BeginRow:=3;  // и с какой строки начинаем заполнение.
     Cell1:=oleApp.WorkSheets[_Sheets].Cells[BeginRow,BeginCol];
     Cell2:=oleApp.WorkSheets[_Sheets].Cells[BeginRow+RowCount-1,BeginCol+ColCount-1];
     oleApp.WorkSheets[_Sheets].Range[Cell1,Cell2].Select;
     oleApp.SELECTION.Value:=ArrayData;
     oleApp.SELECTION.FONT.SIZE:=9;
     oleApp.SELECTION.FONT.Name:='Times New Roman';
     oleApp.SELECTION.WrapText:=True;
  //понял, надеюсь, что здесь происходит - выделяем область в Excel, 
//и присваиваем ей значения массива

//теперь можно поразукрашивать строки
     for i:=1 to RowCount do
       begin
         if ArrayColor[i,2]=1 then
            begin
              Cell1:=oleApp.WorkSheets[_Sheets].Cells[i+2,1];
              Cell2:=oleApp.WorkSheets[_Sheets].Cells[i+2,ColCount];
              oleApp.WorkSheets[_Sheets].Range[Cell1,Cell2].Select;
              oleApp.Selection.Interior.ColorIndex:= 15; // цвет строки
              Cell1:=oleApp.WorkSheets[_Sheets].Cells[i+2,2];
              Cell2:=oleApp.WorkSheets[_Sheets].Cells[i+2,2];
              oleApp.WorkSheets[_Sheets].Range[Cell1,Cell2].Select;
              oleApp.Selection.Font.Italic:= True;
            end;
       end;
//И закрываем Excel
     oleApp.ActiveWindow.Close;
     oleApp.Application.QUIT;
ShowMessage('Сформирован Excel файл: '+_txt);

end;

--------------------

bartram

Дата 8.8.2005, 06:43 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Комодератор
Сообщений: 1606
Регистрация: 22.2.2004
Где: Russia, Samara

Репутация: нет
Всего: 29

Grig, спасибо за совет, попробую smile

--------------------

В каждом из нас спит гений, но с каждым днем все крепче ;-)
bartram.ru
Twitter
user posted image

bartram

Дата 8.8.2005, 12:17 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Комодератор
Сообщений: 1606
Регистрация: 22.2.2004
Где: Russia, Samara

Репутация: нет
Всего: 29

Цитата(Grig @ 8.8.2005, 03:12)

oleApp:=CreateOleObject('Excel.Application');

Ругается "Неизвестный идентификатор" smile

Grig, у тебя какая версия Делфи?

--------------------

В каждом из нас спит гений, но с каждым днем все крепче ;-)
bartram.ru
Twitter
user posted image

Grig

Дата 9.8.2005, 04:37 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 809
Регистрация: 29.4.2005
Где: Иркутск

Репутация: 4
Всего: 16

Я использую Delphi 7.
А чтобы вся эта беда у тебя заработала, в uses пропиши ComObj

--------------------

bartram

Дата 9.8.2005, 07:59 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Комодератор
Сообщений: 1606
Регистрация: 22.2.2004
Где: Russia, Samara

Репутация: нет
Всего: 29

Grig, я запутался одни ошибки в Ран тайме smile

--------------------

В каждом из нас спит гений, но с каждым днем все крепче ;-)
bartram.ru
Twitter
user posted image

Grig

Дата 9.8.2005, 08:40 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 809
Регистрация: 29.4.2005
Где: Иркутск

Репутация: 4
Всего: 16

Покажь код..

--------------------

bartram

Дата 9.8.2005, 09:51 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Комодератор
Сообщений: 1606
Регистрация: 22.2.2004
Где: Russia, Samara

Репутация: нет
Всего: 29

Вот:

Код


procedure TStatContry.N2Click(Sender: TObject);
var
_txt,_txt1:string;
    Cell1,Cell2,ArrayData,ArrayColor:variant;
    BeginCol,BeginRow,i:integer;
    ColCount,RowCount:integer;
    oleApp:Variant;
    _Sheets:integer;
label 1;
begin
if SaveDialog.execute
then
begin
RowCount:=sql1.RecordCount;//считаешь количество строк
ColCount:=2;//сколько столбцов будет в EXCEL-таблице
     oleApp:=CreateOleObject('Excel.Application');
     oleApp.WorkBooks.Add();
     _txt:=SaveDialog.FileName;
     oleApp.ActiveWorkBook.SaveAs(_txt);
     oleApp.Workbooks.Open(_txt);
    // заполнение таблицы EXCEL - по листам
     oleApp.WorkSheets[1].Select;
     oleApp.WorkSheets[1].Name:='Статистика по странам';
   ArrayColor:=VarArrayCreate([1,RowCount,1,2],varVariant);
     ArrayData:=VarArrayCreate([1,RowCount,1,ColCount],varVariant);
sql1.First;//твоя таблица
    For i:=1 to RowCount do
           ArrayData[i,1]:=sql1.FieldByName('name').AsString;
           ArrayData[i,2]:=sql1.FieldByName('Expr1001').AsString;
            sql1.Next;
        end;    
     BeginCol:=1;   //с какого столбца    
     BeginRow:=3;  // и с какой строки начинаем заполнение.    
     Cell1:=oleApp.WorkSheets[_Sheets].Cells[BeginRow,BeginCol];    
     Cell2:=oleApp.WorkSheets[_Sheets].Cells[BeginRow+RowCount-1,BeginCol+ColCount-1];
     oleApp.WorkSheets[_Sheets].Range[Cell1,Cell2].Select;
     oleApp.SELECTION.Value:=ArrayData;    
     oleApp.SELECTION.FONT.SIZE:=9;    
     oleApp.SELECTION.FONT.Name:='Times New Roman';    
     oleApp.SELECTION.WrapText:=True;    
  //понял, надеюсь, что здесь происходит - выделяем область в Excel,    
//и присваиваем ей значения массива    
//теперь можно поразукрашивать строки    
     for i:=1 to RowCount do    
       begin    
         if ArrayColor[i,2]=1 then    
            begin    
              Cell1:=oleApp.WorkSheets[_Sheets].Cells[i+2,1];    
              Cell2:=oleApp.WorkSheets[_Sheets].Cells[i+2,ColCount];    
              oleApp.WorkSheets[_Sheets].Range[Cell1,Cell2].Select;    
              oleApp.Selection.Interior.ColorIndex:= 15; // цвет строки    
              Cell1:=oleApp.WorkSheets[_Sheets].Cells[i+2,2];    
              Cell2:=oleApp.WorkSheets[_Sheets].Cells[i+2,2];    
              oleApp.WorkSheets[_Sheets].Range[Cell1,Cell2].Select;    
              oleApp.Selection.Font.Italic:= True;    
            end;    
       end;    
//И закрываем Excel    
     oleApp.ActiveWindow.Close;    
     oleApp.Application.QUIT;

--------------------

В каждом из нас спит гений, но с каждым днем все крепче ;-)
bartram.ru
Twitter
user posted image

Grig

Дата 9.8.2005, 10:35 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 809
Регистрация: 29.4.2005
Где: Иркутск

Репутация: 4
Всего: 16

в начале процедуры поставь

Код


_Sheets:=1;

и убери пока все что связано с ArrayColor.
Ты его создаешь, но ничем не заполняешь..
может там собака порылась..
хотя вряд ли.
Скорей всего, из-за того, что у тебя не написан

Код


_Sheets:=1;

Дельфя пытается обратится к нулевому листу, а такового в природе нет.

--------------------

Grig

Дата 9.8.2005, 12:36 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 809
Регистрация: 29.4.2005
Где: Иркутск

Репутация: 4
Всего: 16

Код


_txt:=SaveDialog.FileName;

значение _txt чему равно?
по-моему правильней

Код


_txt:=SaveDialog.FileName+'.xls';

--------------------

Akella

Дата 9.8.2005, 13:17 (ссылка)

(нет голосов)

Загрузка ...

Творец

Профиль
Группа: Модератор
Сообщений: 18485
Регистрация: 14.5.2003
Где: Корусант

Репутация: 29
Всего: 329

а не легче сохранить таблицу в текствый файл с расширением xls
в качестве разделителей колонок ставь #9, т.е. табулятор.
Excel ентот файл нормально откроет.
Добавлено @ 13:21

Код


Var
 List:TStringList;
Table1.first;
 List:=TStringList.create;
While not Table1.eof do
begin
  List.add(Table1.Field[0] + #9 + Table1.Field[1]+ #9+Table1.Field[2]);
  Table1.next;
end;
List.SaveToFile(c:\myTable.xls);

bartram

Дата 9.8.2005, 18:07 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Комодератор
Сообщений: 1606
Регистрация: 22.2.2004
Где: Russia, Samara

Репутация: нет
Всего: 29

Цитата(dsergey @ 9.8.2005, 13:17)

List.add(Table1.Field[0] + #9 + Table1.Field[1]+ #9+Table1.Field[2]);

Код не правильный! Я тут чуть чуть подправил

Код


procedure TStatContry.N2Click(Sender: TObject);
Var
 List:TStringList;
 begin
sql1.first;
 List:=TStringList.create;

 if SaveDialog.Execute then
While not sql1.eof do
begin
  List.add((sql1.Fields.Fields[0]) + #9 + (sql1.Fields.Fields[1])+ #9 +(sql1.Fields.Fields[2]));
  sql1.next;
end;
List.SaveToFile(SaveDialog.FileName);
end;
end;

пишет "Несопоставимые типы"
вот на этой строке:

Код


  List.add((sql1.Fields.Fields[0]) + #9 + (sql1.Fields.Fields[1])+ #9 +(sql1.Fields.Fields[2]));

Это сообщение отредактировал(а) bartram - 9.8.2005, 18:08

--------------------

В каждом из нас спит гений, но с каждым днем все крепче ;-)
bartram.ru
Twitter
user posted image

Grig

Дата 10.8.2005, 03:20 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 809
Регистрация: 29.4.2005
Где: Иркутск

Репутация: 4
Всего: 16

dsergey, Браво!!
Этого в книжках не прочитаешь!
Это опыт..
Только опыт.

--------------------

Akella

Дата 10.8.2005, 10:37 (ссылка)

(нет голосов)

Загрузка ...

Творец

Профиль
Группа: Модератор
Сообщений: 18485
Регистрация: 14.5.2003
Где: Корусант

Репутация: 29
Всего: 329

Код


  List.add(sql1.FieldByName('FieldName1').AsString + #9 + 
                sql1.FieldByName('FieldName2').AsString + #9 + 
                sql1.FieldByName('FieldName3').AsString)

Akella

Дата 10.8.2005, 11:30 (ссылка)

(нет голосов)

Загрузка ...

Творец

Профиль
Группа: Модератор
Сообщений: 18485
Регистрация: 14.5.2003
Где: Корусант

Репутация: 29
Всего: 329

Вот тебе рабочий код. smile

Сам проверил. smile

Код


procedure ExportToExcel(DBGrid:TDBGrid);
Var
  List:TStringList;
  Rec,i:integer;
  S:string;
  State:Boolean;
begin
try
  State := DBGrid.DataSource.DataSet.Active;
  if not DBGrid.DataSource.DataSet.Active then
    DBGrid.DataSource.DataSet.Open;
  List:=TStringList.Create;
  List.Clear;
  For i := 0 to DBGrid.Columns.Count-1 do
    s := s + DBGrid.Columns[i].Title.Caption + #9;
  s := s + #13#10;
  DBGrid.DataSource.DataSet.DisableControls;
    Rec := DBGrid.DataSource.DataSet.RecNo;
    DBGrid.DataSource.DataSet.First;
    while not DBGrid.DataSource.DataSet.Eof do
    begin
      For i := 0 to DBGrid.Columns.Count-1 do
        s := s + DBGrid.DataSource.DataSet.FieldByName(DBGrid.Columns[i].FieldName).AsString+#9;
      s := s + #13#10;
      DBGrid.DataSource.DataSet.Next;
    end;//while
    DBGrid.DataSource.DataSet.RecNo := Rec;
finally
    DBGrid.DataSource.DataSet.EnableControls;
    DBGrid.DataSource.DataSet.Active := State;
    List.Add(s);
    List.SaveToFile('c:\11.xls');
    FreeAndNil(List);
end;
end;

Использование

Код


  ExportToExcel(DBGrid1);

Но это по простому, а если тебе нужно с форматированием, т.е. размер шрифта, формат ячейки, то это уже без обращения COM-объекту не обойтись smile

Это сообщение отредактировал(а) dsergey - 10.8.2005, 11:39

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Базы данных и репортинг \| Следующая тема »