Array
(
)

Criar planilha de excel no delphi... interessante mas esquec

Host
   - 04 nov 2005

A muito tempo fiz isto, a droga é q ñ tem documentação então é teste e erro, pra tentar achar a solução. Pois bem, la vai o código:

procedure TForm1.Button1Click(Sender: TObject);
var
Excel, Picture, Sheet: Variant;
cTitulo: string;
lin: integer;
erCarro, erPeca, erQtde, erData, erHora,DirToSave: string;
Present1,Present2: TDateTime;
Year, Month, Day, Hour, Min, Sec, MSec,Year2, Month2, Day2, Hour2, Min2, Sec2, MSec2: Word;
begin
try
Present1:=Now;
lin:=3;
cTitulo:= ´Relatório de Consumo de Tinta´;
Excel:= CreateOleObject(´Excel.Application´);
Excel.Visible := True;
Excel.WorkBooks.Add;
Excel.Workbooks[1].Sheets.Add;
inc(lin);
//Cabeçalho
Excel.Workbooks[1].WorkSheets[1].Name := cTitulo;

Sheet:=Excel.Workbooks[1].WorkSheets[cTitulo];
Sheet.Range[´A4´,´I4´].font.name := ´Arial´; // Fonte
Sheet.Range[´A4´,´I4´].font.size := 10; // Tamanho da Fonte
Sheet.Range[´A4´,´I4´].font.bold := true; // Negrito
Sheet.Range[´A4´,´I4´].font.italic := true; // Italico
Sheet.Range[´A4´,´I4´].font.color := clYellow; // Cor da Fonte
Sheet.Range[´A4´,´I4´].Interior.Color := clGreen; // Cor da Célula

// Define o tamanho das Colunas (basta fazer em uma delas e as demais serão alteradas)
Sheet.Range[´A7´].ColumnWidth:= 13;
Sheet.Range[´B7´].ColumnWidth:= 13;
Sheet.Range[´C7´].ColumnWidth:= 15;
Sheet.Range[´D7´].ColumnWidth:= 15;
Sheet.Range[´F7´].ColumnWidth:= 15;
Sheet.Range[´G7´].ColumnWidth:= 14;
Sheet.Range[´H7´].ColumnWidth:= 15;


lin:=lin+1;
Excel.Workbooks[1].Sheets[1].Cells[lin,1]:= ´Data da Coleta´;
Excel.Workbooks[1].Sheets[1].Cells[lin,2]:= ´Hora da Coleta´;
Excel.Workbooks[1].Sheets[1].Cells[lin,3]:= ´Data do Cadastro´;
Excel.Workbooks[1].Sheets[1].Cells[lin,4]:= ´Hora do Cadastro´;
Excel.Workbooks[1].Sheets[1].Cells[lin,5]:= ´Cor´;
Excel.Workbooks[1].Sheets[1].Cells[lin,6]:= ´Componente A´;
Excel.Workbooks[1].Sheets[1].Cells[lin,7]:= ´Componente B´;
Excel.Workbooks[1].Sheets[1].Cells[lin,8]:= ´Volume Total´;
Excel.Workbooks[1].Sheets[1].Cells[lin,9]:= ´Operador´;
lin:=lin+1;
Excel.Workbooks[1].Sheets[1].Cells[lin,1]:= ´04/11/2005´;
Excel.Workbooks[1].Sheets[1].Cells[lin,2]:= ´09:01:11´;
Excel.Workbooks[1].Sheets[1].Cells[lin,3]:= ´04/11/2005´;
Excel.Workbooks[1].Sheets[1].Cells[lin,4]:= ´09:01:11´;
Excel.Workbooks[1].Sheets[1].Cells[lin,5]:= ´Azul´;
Excel.Workbooks[1].Sheets[1].Cells[lin,6]:= ´0´;
Excel.Workbooks[1].Sheets[1].Cells[lin,7]:= ´b´;
Excel.Workbooks[1].Sheets[1].Cells[lin,8]:= ´10,22´;
Excel.Workbooks[1].Sheets[1].Cells[lin,9]:= ´Fulano´;
Sheet.Range[´A5´,´I´+IntToStr(lin-1)].Borders.LineStyle := 1;
Sheet.Range[´A5´,´I´+IntToStr(lin-1)].Borders.Weight := 2;
Sheet.Range[´A5´,´I´+IntToStr(lin-1)].Borders.ColorIndex := 1;
DirToSave:=´C:\DragnDrop\DragnDrop.xls´;
Excel.Workbooks[1].SaveAs( DirToSave );
Sheet.Range[´A5´,´I5´].Select;
Sheet.Range[´A5´,´I5´].Copy;
Sheet.Range[´A6´,´I6´].Select;
Sheet.Range[´A6´,´I6´].past;
//Excel.Visible := True
except
messagedlg( ´Erro ao exportar arquivo !´ + #13 + 13 + ´Carro: ´ + erCarro + 13 + ´Peça: ´ + erPeca + 13 +
´Quantidade: ´ + erQtde + 13 + ´Data: ´ + erData + 13 + ´Hora: ´ + erHora, mterror, [mbok], 0 );
Excel.Quit;
Excel.ActiveDocument.Close(SaveChanges := 0);
end;

A intenção é simples, escreve uma linha e copia e salva na linha abaixo, porem tenho um erro na copia para a linha de baixo , pois não lembro exatamente do commando.


Sabado
   - 04 dez 2005

Para exportar para XLS uso assim:

uses ComObj;

type
procedure GerarExcelT(Consulta:TQuery);

procedure Tform1.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;


Jose Filho
   - 06 set 2017

Consegui implementar essa rotina, mas por alguma razão não gera todos os registros, a primeira vez que coloquei para rodar só gerou um registro, na segunda vez, coloquei um dataset e DBgrid para acompanhar o progresso e só gerou a quantidade de linhas visíveis no DBGrid, o que pode ser?