Fórum Criar Arquivo #218512

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComObj, StdCtrls, Buttons, Grids, DBGrids, DB, DBTables;

type

procedure GerarExcelT(Consulta:TQuery);

private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

{ TForm1 }

procedure TFrm_Prescricao.GerarExcelT(Consulta: TQuery);

var
coluna, linha: integer;
excel: variant;
valor: string;

begin
try
excel:=CreateOleObject(´Excel.Application´);
excel.Workbooks.add(1);
except Application.MessageBox (´Versão do Ms-Excel´+
´Incompatível´,´Erro´,MB_OK+MB_ICONEXCLAMATION);
end;

Consulta.First;
try
for linha:=0 to query1.RecordCount-1 do
begin
for coluna:=1 to query1.FieldCount do
begin
valor:= query1.Fields[coluna-1].AsString; excel.cells [linha+2,coluna]:=valor;
end;
Consulta.Next;

end;
for coluna:=1 to query1.FieldCount do
begin
valor:= query1.Fields[coluna-1].DisplayLabel;
excel.cells[1,coluna]:=valor;
end;
excel.columns.AutoFit;
excel.visible:=true;
except
Application.MessageBox (´Aconteceu um erro desconhecido durante a conversão´+
´da tabela para o Ms-Excel´,´Erro´,MB_OK+MB_ICONEXCLAMATION);
end;
end;
procedure TForm1.BitBtn1Click(Sender: TObject);
begin
GerarExcelT(query1);
end;


Depois é só salvar com o nome que quiser.