[Resolvido] Exportar dados de um DBGrid para XLS em múltiplas pla

[Chrnos 30]

A alguns dias precisei desenvolver uma rotina para exportar consultas com mais de 65.000 linhas para o Excel... o problema que tive é que uma planilha do Excel (versão 2000) possui uma limitação de linhas (pouco mais de 65.500, não lembro agora o valor exato). Ai precisei desenvolver a rotina abaixo para contornar este problema.

 

function TForm1.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 para setar 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 65000
		   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
		  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 na planilha do excell
		  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 nas planilhas
		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