[Resolvido] Exportação de dados para excel

Indiferente se você montar o fonte ou fizer com componente, todas as formas vão ler linha a linha, visto que ele precisa pegar o dado e passar para cada célula, particularmente acho melhor desenvolver o próprio fonte de exportação, no fórum irá encontrar alguns fontes de como pode fazer...

Hehehehe, se for pra fazer linha a linha eu tenho já a rotina de como fazer... o problema é que numa consulta de 137 mil linhas o tempo que leva usando ole é de + de uma hora... ai tinha pensado em usar algum componente pra isso mas no fim das contas vou ficar com a minha rotina que vou por abaixo mesmo pra ajudar alguém que precise exportar em multiplanilhas como eu... pode dar o tópico como resolvido depois.

function TfrmGeradorConsultas.GridToExcelFile(Grid: TDbGrid;ExcelFile: String; TotalRegistros : Integer):Boolean;
var bResult : Boolean;
	SavePlace : TBookmark;
	i,eline : Integer;
	Excel : Variant;
	iSheet	: Integer;
	CorFundo : TColor;

begin

 bResult:= False;
 // If dataset is assigned and active runs Excel
 if Assigned(Grid.DataSource) then
 begin
	if Grid.DataSource.DataSet.Active then
	begin
 try
 //Rotina que chama um painel com um ProgressBar
 SetaPainelMensagem(cExportandoRegistros, TotalRegistros);

 Excel:= CreateOleObject('Excel.Application');
 Excel.Visible:= False;
 Excel.WorkBooks.Add;
 //Definindo o número de worksheets
 if (TotalRegistros > 65000) then
 begin
 if ((TotalRegistros Mod 65000) = 0) then
 iSheet := TotalRegistros DIV 5
 else
 iSheet := (TotalRegistros DIV 65000) + 1;
 if (iSheet > 3) then
 //Adicionando as worksheets que faltam a partir da 3 planilha do excel
 For i:= 4 to iSheet do
 Excel.WorkBooks[1].Sheets.Add(null, Excel.WorkBooks[1].Sheets[i-1]);
 end;
 // Save grid Position
 SavePlace:= Grid.DataSource.DataSet.GetBookmark;
 Grid.DataSource.DataSet.First;
 //Sheet atual
 iSheet := 1;
 // Montando cabeçalho da planilha
 if not (Grid.DataSource.DataSet.Eof) then
 begin
 eline:= 1; // Posicionando na primeira linha da planilha(Sheet) para por o cabeçalho
 for i:=0 to (Grid.Columns.Count-1) do
 begin
 Excel.WorkBooks[1].Sheets[iSheet].Cells[eline,(i+1)] := Grid.Columns[i].Title.Caption;
 Excel.WorkBooks[1].Sheets[iSheet].Cells[eline,(i+1)].ColumnWidth	:= Grid.Columns[i].Field.DisplayWidth;
 Excel.WorkBooks[1].Sheets[iSheet].Cells[eline,(i+1)].Font.FontStyle := 'Negrito';
 Excel.WorkBooks[1].Sheets[iSheet].Cells[eline,(i+1)].Interior.Color := (ColorToRgb(Grid.Columns[i].Title.Color));
 Excel.WorkBooks[1].Sheets[iSheet].Cells[eline,(i+1)].Font.Color := (ColorToRgb(Grid.Columns[i].Title.Font.Color));
 end;
 end;
 while not Grid.DataSource.DataSet.Eof do //Preenchendo o restante da planilha com os dados
 begin
 Inc(eline); //Incrementa a posição da linha para preencher no excel

 //Atualiza Progressbar
 pbInformacao.StepBy(1);
 Application.ProcessMessages;

 //Se passar de 65000 linhas, jogar dado na outra planilha, remontando os cabeçalhos antes
 if (eline > 65000) then
 begin
 Inc(iSheet);
 eline := 1;
 for i:=0 to (Grid.Columns.Count-1) do
 begin
 Excel.WorkBooks[1].Sheets[iSheet].Cells[eline,(i+1)] := Grid.Columns[i].Title.Caption;
 Excel.WorkBooks[1].Sheets[iSheet].Cells[eline,(i+1)].ColumnWidth	:= Grid.Columns[i].Field.DisplayWidth;
 Excel.WorkBooks[1].Sheets[iSheet].Cells[eline,(i+1)].Font.FontStyle := 'Negrito';
 Excel.WorkBooks[1].Sheets[iSheet].Cells[eline,(i+1)].Interior.Color := (ColorToRgb(Grid.Columns[i].Title.Color));
 Excel.WorkBooks[1].Sheets[iSheet].Cells[eline,(i+1)].Font.Color := (ColorToRgb(Grid.Columns[i].Title.Font.Color));
 end;
 Inc(eline);
 end;

 //Para mudar a cor de fundo da linha da planilha
 If (eline mod 2) = 0 then
 CorFundo := clInfoBk
 else
 CorFundo := clAqua;

 for i:=0 to (Grid.Columns.Count-1) do
 begin
 Excel.WorkBooks[1].Sheets[iSheet].Cells[eline,(i+1)] := Grid.Columns[i].Field.AsString;
 Excel.WorkBooks[1].Sheets[iSheet].Cells[eline,(i+1)].Interior.Color := (ColorToRgb(CorFundo));
 Excel.WorkBooks[1].Sheets[iSheet].Cells[eline,(i+1)].Font.Color := (ColorToRgb(Grid.Columns[i].Font.Color));
 Excel.WorkBooks[1].Sheets[iSheet].Cells[eline,(i+1)].Borders.Color := (ColorToRgb(clGray));
 end;
 Grid.DataSource.DataSet.Next;
 end;

 //Ajustando o tamanho das colunas
 For i:= 1 to iSheet do
 Excel.WorkBooks[1].WorkSheets[i].Range['B1','AQ1000'].Columns.AutoFit;

 // Set saved grid position
 Grid.DataSource.DataSet.GotoBookmark(SavePlace);
 // Salvando o arquivo
 Excel.WorkBooks[1].SaveAs(ExcelFile);
 Excel.Quit;
 bResult:= True;
 pnlMensagem.Visible := False;
 except
 bResult:= False;
 Excel.Quit;
 pnlMensagem.Visible := False;
 end;
	end;
 end;
 Result := bResult;
end;

[]'s

O que pode ainda influencia é o BD que esta usando e os componentes, que podem afetar em alguma coisa a mais no rendimento, e claro o computador que gera o arquivo.

O problema em si não é a carga dos dados no dbgrid, isto até que ele faz rápido... é a exportação do dbgrid para o excell que é lenta mesmo hehehe. Mas por hora vai ficar assim mesmo o aplicativo, coloquei um alerta pro usuário que dependendo do número de registros a serem exportados o tempo pode variar... por hora não tem stress nisto hehehe.

beleza... usuário precisa ter paciência :D

Eu estava com o mesmo Problema que você.. Precisava exportar 15000 e demorava muito

entao eu exportei em CSV... nao sei se isso resolve seu problema .. mais aqui demora menos de 2 min xD

ae va o codigo

Procedure CriarCsv(Qry:TADOQuery);
Var

 Arquivo:TextFile;
 ValorDoCampo,NomeDoCampo:String;
 I:Integer;

 Assign(Arquivo,'C:\Produtos.csv');
 Rewrite(Arquivo);
 QRY.First;
 //Escreve Nome dos Campos
 For i:=0 to Qry.FieldCount-1 Do
	Begin
 NomeDoCampo:=Qry.Fields[i].FieldName;
 Write(Arquivo,NomeDoCampo+';');
	End;
 Writeln(Arquivo,'');
 //Adicionar Valores separados por ';'
 While Not QRY.Eof dO
	Begin
 for i:=0 TO qry.FieldCount-1 do
 Begin
 ValorDoCampo:=qry.Fields[I].AsString;
 Write(Arquivo,ValorDoCampo+';');
 End;
 Writeln(Arquivo,'');
 QRY.Next;
	End;
 CloseFile(Arquivo);
End;  

Espero que ajude

Flw's

Hehehe, ajudaria se desse pra abrir o CSV direto do delphi com as tabelas já formatadas... o problema é que abrindo o csv direto pelo delphi ele não separava as colunas, tinha que ir no excel e mandar abrir no formato csv pra isso... sem falar que eu tenho casos que exporto mais de 65 mil registros, ai no csv ele não quebra isso em múltiplas planilhas... ou seja, tive que usar o método que coloquei aqui mesmo pra resolver a questão, não teve jeito. Mas valeu pelo código Lancellotte! Pode ajudar a outros. http://forum.imasters.com.br/public/style_emoticons/default/clap.gif

Tenta fazer algo do tipo

Function CsvToExcelFile(ArquivoCsv: String;ArquivoExcel:String):Boolean;
Var
Excel : Variant;
Begin

 Excel:=CreateOleObject('Excel.Application');
 Excel.Visible:=false;
 //Abre o CSV
 Excel.WorkBooks.Open(ArquivoCsv);
 //Salva em XLS
 Excel.WorkBooks.SaveAs(ArquivoExcel);
 Excel.Quit;
 DeleteFile(ArquivoCsv);

End;

Eu exporto e Importo em Csv..

No caso de Passar de 65000, você cria dois Csv.. e depois junta em um unico XLS em planilhas diferentes

Flw's... Abraço http://forum.imasters.com.br/public/style_emoticons/default/thumbsup.gif

PS: Nao testei esses comandos