Экспорт Отчётов в Excel из ADOQuery

[kucher69]

МОЖЕТ КТО_НИБУДЬ СТАЛКИВАЛСЯ!
имеется такой код для создания отчётов чисто по таблице!
а как сделать универсальный (ЕСЛИ ЭТО ВООБЩЕ ВОЗМОЖНО) экспорт отчётов по ЗАПРОСАМ ADOQuery
ВОТ САМ КОД

procedure TfMain.Button9Click(Sender: TObject);
Var
XLApp,Sheet,Colum:Variant;
index,i:integer;
begin
    XLApp:=CreateOLEObject('Excel.Application'); //Строка создаёт объект Excel и записывает его в переменную
    XLApp.Visible:=true; //объект видимый EXcel
    XLApp.Workbooks.Add(-4167); //Excel состоит из книг (страниц), которые мы добавляем.
    //Число - константа, менять нельзя
 
    //Функция, которая создаёт OLE-объекты позволяет наладить связь с другим приложением
    XLApp.Workbooks[1].WorkSheets[1].Name:='Отчёт';
    Colum:=XLApp.Workbooks[1].WorkSheets['Отчёт'].Columns;
 
   //Ширина столбцов
    Colum.Columns[2].ColumnWidth:=30;
    Colum.Columns[3].ColumnWidth:=20;
    Colum.Columns[4].ColumnWidth:=20;
    Colum.Columns[5].ColumnWidth:=20;
    Colum.Columns[6].ColumnWidth:=20;
 
    Colum:=XLApp.Workbooks[1].WorkSheets['Отчёт'].Rows; //Переносим указатель на строки
    Colum.Rows[2].Font.Bold:=true;   //Меняется шрифт
    Colum.Rows[1].Font.Bold:=true;
    Colum.Rows[1].Font.Color:=clRed;  //Цвет строки
    Colum.Rows[1].Font.Size:=14;      //Размер шрифта
 
    Sheet:=XLApp.Workbooks[1].WorkSheets['Отчёт']; //Указатель на лист
    Sheet.Cells[1,2]:='Заказы'; // Название таблицы
    Sheet.Cells[2,1]:='ИдКлиента';
    Sheet.Cells[2,2]:='ИдТовара';                    //Шапка таблицы
    Sheet.Cells[2,3]:='ДатаЗаказа';
    Sheet.Cells[2,4]:='Срочность';
    Sheet.Cells[2,5]:='Колличество';
 
    fDM.TZakaziData.First;
    index:=3;
    //Цикл для вывода данных таблицы
    for i:=0 to fDM.TZakaziData.RecordCount do begin
    //Наполнение таблицы
    sheet.Cells[index,1]:=fDM.TZakaziData.Fields.Fields[1].AsString;
    sheet.Cells[index,2]:=fDM.TZakaziData.Fields.Fields[2].AsString;
    sheet.Cells[index,3]:=fDM.TZakaziData.Fields.Fields[3].AsString;
    sheet.Cells[index,4]:=fDM.TZakaziData.Fields.Fields[4].AsString;
    sheet.Cells[index,5]:=fDM.TZakaziData.Fields.Fields[5].AsString;
    Inc(index);
    fDM.TZakaziData.Next; //Переход на следующую строку
    end;  end;

[come-on]

Что значит универсальный?
Универсального вообще ничего нет в природе.

[kucher69]

в плане того чтобы можно было любой запрос выводить!
я имею в виду
как например менять

    Sheet:=XLApp.Workbooks[1].WorkSheets['Отчёт']; //Указатель на лист
    Sheet.Cells[1,2]:='Заказы'; // Название таблицы
    Sheet.Cells[2,1]:='ИдКлиента';
    Sheet.Cells[2,2]:='ИдТовара';                    //Шапка таблицы
    Sheet.Cells[2,3]:='ДатаЗаказа';
    Sheet.Cells[2,4]:='Срочность';
    Sheet.Cells[2,5]:='Колличество';

шапку не смому прописывая, а что бы данные брались из запроса

[come-on]

в запросах никаких шапок нет, запрос это то что уходит, а не то что приходит
вы сформулируйте нормально что вам надо, а то пока гадание сплошное

А вообще, что то что может походить на универсализм, это шаблоны. Готовите шаблоны, потом их наполняете данными.

[phomm]

шапку не смому прописывая, а что бы данные брались из запроса

for i := 1 to fDM.TZakaziData.Fields.Count do
  Sheet.Cells[1,i]:= fDM.TZakaziData.Fields[i].FieldName;

Только для этого надо в запросе именовать поля выборки у казывая AS Некое_Имя

[kucher69]

попробовал сделать что бы выводило в EXcel из ADOQuery

procedure TForm1.Button1Click(Sender: TObject);
var
 XLApp,Sheet,Colum:Variant;
 index,i:Integer;
begin
 XLApp:= CreateOleObject('Excel.Application');
 XLApp.Visible:=true;
 XLApp.Workbooks.Add(-4167);
 XLApp.Workbooks[1].WorkSheets[1].Name:='Отчёт';
 
 Sheet:=XLApp.Workbooks[1].WorkSheets['Отчёт'];
 
for i := 1 to fDM.DSQuery1.Fields.Count do
  Sheet.Cells[1,i]:= fDM.DSQuery1.Fields[i].FieldName;

fDM.DSQuery1.First;
    index:=3;
    //Цикл для вывода данных таблицы
    for i:=0 to fDM.DSQuery1.RecordCount do begin
    //Наполнение таблицы
	for i := 1 to fDM.DSQuery1.Fields.Count do begin
    Sheet.Cells[index,i]:= fDM.DSQuery1.Fields.Fields[i].AsString;
	end;
	Inc(index);
	fDM.DSQuery1.Next; //Переход на следующую строку
    end;
  end;

появились следующие ошибки

[Error] Main.pas(319): Undeclared identifier: 'Fields'
[Error] Main.pas(325): Assignment to FOR-Loop variable 'i'
[Error] Main.pas(325): Undeclared identifier: 'RecordCount'
[Error] Main.pas(327): Assignment to FOR-Loop variable 'i'
[Error] Main.pas(327): Undeclared identifier: 'Fields'
[Error] Main.pas(328): Undeclared identifier: 'Fields'
[Error] Main.pas(328): Missing operator or semicolon
[Error] Main.pas(331): Undeclared identifier: 'Next'
[Error] Main.pas(335): '.' expected but ';' found
[Fatal Error] GK.dpr(7): Could not compile used unit 'Main.pas'

[kucher69]

такой вопрос как сделать чтобы в этом коде

//Цикл для вывода данных таблицы
    for i:=0 to fDM.TZakaziData.RecordCount do begin
    //Наполнение таблицы
    sheet.Cells[index,1]:=fDM.TZakaziData.Fields.Fields[1].AsString;
    sheet.Cells[index,2]:=fDM.TZakaziData.Fields.Fields[2].AsString;
    sheet.Cells[index,3]:=fDM.TZakaziData.Fields.Fields[3].AsString;
    sheet.Cells[index,4]:=fDM.TZakaziData.Fields.Fields[4].AsString;
    sheet.Cells[index,5]:=fDM.TZakaziData.Fields.Fields[5].AsString;
    Inc(index);
    fDM.TZakaziData.Next; //Переход на следующую строку
    end;

не нужно было прописывать 5 раз

sheet.Cells[index,1]:=fDM.TZakaziData.Fields.Fields[1].AsString;
    sheet.Cells[index,2]:=fDM.TZakaziData.Fields.Fields[2].AsString;
    sheet.Cells[index,3]:=fDM.TZakaziData.Fields.Fields[3].AsString;
    sheet.Cells[index,4]:=fDM.TZakaziData.Fields.Fields[4].AsString;
    sheet.Cells[index,5]:=fDM.TZakaziData.Fields.Fields[5].AsString;

и цикл сам определял сколько нужно в столбце строк (5, 6, 7 от того сколько в таблице)
Я ВОТ ПОПРОБЫВАЛ НО НЕ РАБОТАЕТ, НО принцип такой вроде как

    fDM.TZakaziData.First;
    index:=3;
    //Цикл для вывода данных таблицы
    for i:=0 to fDM.TZakaziData.RecordCount do begin
 //   sheet.Cells[index,1]:=fDM.TZakaziData.Fields.Fields[1].AsString;
 //   sheet.Cells[index,2]:=fDM.TZakaziData.Fields.Fields[2].AsString;
 //   sheet.Cells[index,3]:=fDM.TZakaziData.Fields.Fields[3].AsString;
 //   sheet.Cells[index,4]:=fDM.TZakaziData.Fields.Fields[4].AsString;
 //   sheet.Cells[index,5]:=fDM.TZakaziData.Fields.Fields[5].AsString;

     for j := 1 to fDM.TZakaziData.Fields.Count-1 do  begin
     Sheet.Cells[index,j]:= fDM.TZakaziData.Fields.Fields[j].AsString;
     end;
    Inc(index);
    fDM.TZakaziData.Next; //Переход на следующую строку
    end;

[xxbesoxx]

Сообщение от kucher69

в плане того чтобы можно было любой запрос выводить!
я имею в виду
как например менять

    Sheet:=XLApp.Workbooks[1].WorkSheets['Отчёт']; //Указатель на лист
    Sheet.Cells[1,2]:='Заказы'; // Название таблицы
    Sheet.Cells[2,1]:='ИдКлиента';
    Sheet.Cells[2,2]:='ИдТовара';                    //Шапка таблицы
    Sheet.Cells[2,3]:='ДатаЗаказа';
    Sheet.Cells[2,4]:='Срочность';
    Sheet.Cells[2,5]:='Колличество';

шапку не смому прописывая, а что бы данные брались из запроса

Можно . Но, тогда к БД на все таблице надо делать SQL запрос только из одного Adoquery и SQL запрос тогда надо писать допустим через Memo1
1)

procedure TForm1.Button1Click(Sender: TObject);
begin
 if Trim(Memo1.Lines.Text)='' then
 begin
   ShowMessage('Пишите SQL Запрос');
   Memo1.SetFocus;
 end
 else
 With ADOQuery1 do
 begin
   Close;
   SQL.Clear;
   SQL.Add(Trim(Memo1.Lines.Text));
   Open;
 end;
end;

2)

 if  (ADOQuery1.Active<>false) then
 begin
// Данные в ADOQuery1 до этого момента считаем уже сформированными
  // Создаем новую копию Excel
   Excel:=CreateOleObject('Excel.Application');
// Добавляем рабочую книгу
   Excel.Workbooks.Add;
   // Даём название страничке
    Excel.WorkBooks[1].WorkSheets[1].Name := 'Прайс лист';
   // ---------------------Цвет поля -------------------
  //  Excel.SetRangecolor('1','A1',15);
  //--------------------------------------------
 // Иногда полезно уметь установить и ориентацию страницы
    Excel.ActiveSheet.PageSetup.Orientation:= 2;
   //---------------------------------------------------
   /// Левое и правое поля отступа для печати
   Excel.WorkBooks[1].WorkSheets[1].PageSetup.LeftMargin := 20; // 
   Excel.WorkBooks[1].WorkSheets[1].PageSetup.RightMargin := 10;
   //----------------------------------------------------------------------------
 { Excel.ActiveWorkBook.WorkSheets[1].Range['G1'].Select;
  Excel.Selection.Font.Bold:=true; // Для жирного текста
  Excel.Selection.Font.Italic:=true; // Для наклонного текста}
  // Устанавливаем размер массива с данными для экспорта
   FData:=VarArrayCreate([1,ADOQuery1 .RecordCount+1,1,ADOQuery1.Fields.Count],varVariant);
 // первую строку заполняем названиями столбцов
   for j:=1 to ADOQuery1 .Fields.Count do
      FData[1,j]:= ADOQuery1.Fields[j-1].DisplayName;
// Заполняем массив
   ADOQuery1.First;
   i:=2;
   while not ADOQuery1.Eof do
      begin
         for j:=1 to ADOQuery1.Fields.Count do
            FData[i,j]:=ADOQuery1.Fields[j-1].Value;
         ADOQuery1.Next;i:=i+1;
      end;
 // Копируем данные в Excel
   Excel.Range[Excel.Cells[1, 1], Excel.Cells[ADOQuery1.RecordCount+1, ADOQuery1.Fields.Count]].Value:=FData;
// Рисуем границы вокруг данных
   Excel.Range[Excel.Cells[1, 1], Excel.Cells[ADOQuery1.RecordCount+1, ADOQuery1.Fields.Count]].Select;
   Excel.Selection.Borders.LineStyle := 1;
   Excel.Selection.Borders.Weight := 2;
   Excel.Range[Excel.Cells[1, 1], Excel.Cells[1, 1]].Select;
// Меняем цвет ячеек в первой строке (названия стоблцов)
   Excel.Range[Excel.Cells[1, 1], Excel.Cells[1, ADOQuery1.Fields.Count]].Interior.ColorIndex:=15;
// Автоматически изменяем ширину столбцов и делаем Excel видимым
   Excel.Columns.AutoFit;
   Excel.Visible:=True;
 end;
end;

end.

На учебное БД есть несколько таблица . пишите запрос в Memo1 и потом экспортируйте в Excel

[Аватар]

не нужно было прописывать 5 раз

Примерно так

  ADOQuery1.First;
  while not ADOQuery1.Eof do begin
    for i:=0 to ADOQuery1.Fields.Count-1 do Sheet.Cells[index,i]:= ADOQuery1.Fields.Fields[i].AsString;
    Inc(index);
    ADOQuery1.Next;
  end;

[Heneken87]

Выведет все что в SELECT и создаст заголовки жирным
var i,ii:integer;
....

ADOQuery1.open;
for ii := 1 to ADOQuery1.FieldDefList.Count do
    Sheet.cells[1, ii] := ADOQuery1.FieldDefs[ii-1].Name;
 Sheet.Rows[1].Font.Bold:=1;
ADOQuery1.first;
  i := 2;
  while (not ADOQuery1.Eof) do
  begin
    for ii := 1 to ADOQuery1.FieldDefList.Count do
    begin
      Sheet.cells[i, ii] := ''''+ADOQuery1.Fields[ii - 1].AsString;
    end;
    i := i + 1;//inc(i);
    ADOQuery1.Next;
  end;