Fórum [delphi] Exemplo de código Delphi com uso de ComObj (OleObject) - Excel #600138
30/01/2019
0
compartilhando o código com a comunidade ;)
class procedure TRelatorioVenda.Exportar;
Var
Excel: Variant;
AbaResumo: Variant;
Linha: Integer;
begin
try
Excel := CreateoleObject('Excel.Application');
Excel.Visible := True;
Excel.WorkBooks.add;
Excel.Workbooks[1].WorkSheets[1].cells[1,1].Value := 'Relatorio de Vendas';
Excel.Workbooks[1].WorkSheets[1].cells[1,1].Font.Name := 'Arial';
Excel.Workbooks[1].WorkSheets[1].cells[1,1].Font.Bold := True;
Excel.Workbooks[1].WorkSheets[1].cells[1,1].Font.Italic := True;
Excel.Workbooks[1].WorkSheets[1].cells[1,1].Font.Size := 22;
Excel.Workbooks[1].WorkSheets[1].cells[1,1].Font.Color := $00F32131;
Excel.Workbooks[1].WorkSheets[1].cells[1,1].Interior.Color := $00F2DFC6;
Excel.Workbooks[1].WorkSheets[1].cells[1,1].RowHeight := 30;
Excel.Workbooks[1].WorkSheets[1].cells[1,1].Borders.LineStyle := 1;
Excel.Workbooks[1].WorkSheets[1].cells[1,1].HorizontalAlignment := 3;
Excel.Workbooks[1].WorkSheets[1].Range['A1','E1'].MergeCells := True;
Excel.Workbooks[1].WorkSheets[1].Name := 'Rel. Vendas';
Excel.Workbooks[1].WorkSheets[1].cells[2,1].Value := 'Cod.';
Excel.Workbooks[1].WorkSheets[1].cells[2,2].Value := 'Cliente';
Excel.Workbooks[1].WorkSheets[1].cells[2,3].Value := 'Data';
Excel.Workbooks[1].WorkSheets[1].cells[2,4].Value := 'Valor';
Excel.Workbooks[1].WorkSheets[1].cells[2,5].Value := 'Qtde';
Excel.Workbooks[1].WorkSheets[1].Range['A2','E2'].Font.Bold := True;
Excel.Workbooks[1].WorkSheets[1].Range['A2','E2'].Font.Size := 12;
Excel.Workbooks[1].WorkSheets[1].Range['A2','E2'].Font.Color := $00F32131;
Excel.Workbooks[1].WorkSheets[1].Range['A2','E2'].Interior.Color := $00F2DFC6;
Linha := 3;
DM.FDQryVenda.Open;
while not DM.FDQryVenda.Eof do
begin
Excel.Workbooks[1].WorkSheets[1].cells[Linha,1].Value := DM.FDQryVenda.FieldByName('IDVenda' ).AsInteger;
Excel.Workbooks[1].WorkSheets[1].cells[Linha,2].Value := DM.FDQryVenda.FieldByName('Cliente' ).AsString;
Excel.Workbooks[1].WorkSheets[1].cells[Linha,3].Value := DM.FDQryVenda.FieldByName('Data' ).AsDateTime;
Excel.Workbooks[1].WorkSheets[1].cells[Linha,4].Value := DM.FDQryVenda.FieldByName('Valor_Total').AsCurrency;
Excel.Workbooks[1].WorkSheets[1].cells[Linha,5].Value := DM.FDQryVenda.FieldByName('Qnt_Itens' ).AsInteger;
DM.FDQryVenda.Next;
Linha := Linha +1;
end;
Excel.Workbooks[1].WorkSheets[1].cells[Linha, 1].Value := '=COUNT(A3:A'+IntToStr(Linha-1)+')';
Excel.Workbooks[1].WorkSheets[1].cells[Linha, 1].Font.Bold := True;
Excel.Workbooks[1].WorkSheets[1].cells[Linha, 1].RowHeight := 25;
Excel.Workbooks[1].WorkSheets[1].cells[Linha, 4].Value := '=SUM(D3:D'+IntToStr(Linha-1)+')';
Excel.Workbooks[1].WorkSheets[1].cells[Linha, 4].NumberFormat := 'R$#.##0,00';
Excel.Workbooks[1].WorkSheets[1].cells[Linha, 4].Font.Bold := True;
Excel.Workbooks[1].WorkSheets[1].cells[Linha, 4].RowHeight := 25;
Excel.Workbooks[1].WorkSheets[1].Columns.Autofit;
AbaResumo := Excel.Worksheets.Add(EmptyParam, Excel.Workbooks[1].WorkSheets[1]);
AbaResumo.Name := 'Resumo';
AbaResumo.cells[1,1].Value := 'Resumo das vendas';
AbaResumo.cells[1,1].Font.Bold := True;
AbaResumo.cells[1,1].Font.Italic := True;
AbaResumo.cells[1,1].Font.Size := 22;
AbaResumo.cells[1,1].RowHeight := 30;
AbaResumo.Columns.Autofit;
Excel.Workbooks[1].SaveAs('d:\\planilha_vendas.xlsx');
Excel.Quit;
finally
if not VarIsEmpty(Excel) then
Excel := Unassigned;
if not VarIsEmpty(AbaResumo) then
AbaResumo := Unassigned;
end;
end;
Gladstone Matos
Curtir tópico
+ 1
Responder
Post mais votado
31/01/2019
Poxa tone, valeu... precisei de algo assim um tempo atrás para importar arquivos do excel...
Hélio Devmedia
Responder
Gostei + 1
Mais Posts
31/01/2019
Gladstone Matos
Poxa tone, valeu... precisei de algo assim um tempo atrás para importar arquivos do excel...
obrigado @Helio! :D
Responder
Gostei + 0
Clique aqui para fazer login e interagir na Comunidade :)