(Resolvido)Exportar para excell

[João Paulo Taraciuk]

Olá pessoal, estou fazendo um projeto, onde o cliente faz pedidos e manda por e-mail para o seu fornecedor, então pensei em utilizar o excell, estou utilizando o procedimento seguinte

procedure Tfrm_pedidos.Button3Click(Sender: TObject);
var excel :variant;
i, a:integer;
begin
try
excel := CreateOleObject('excel.application');
if not Excel.Application.Visible then
Excel.Application.Visible := true;
Excel.WorkBooks.Add;
ZQuery_gridpesq.First;
  i:=0;
  a:=4;//esta variável é onde vai o valor total
  While not .ZQuery_gridpesq.Eof do
   begin
    inc(i);
    Excel.Cells[i, 1] := ZQuery_gridpesq.FieldbyName('descricao').asString;
    Excel.Cells[i, 2] := ZQuery_gridpesq.FieldbyName('quantidade').asString;
    Excel.Cells[i, 3] := ZQuery_gridpesq.FieldbyName('valor_unit').AsFloat;
    Excel.Cells[i, 4] := ZQuery_gridpesq.FieldbyName('valor_total').AsFloat;
    ZQuery_gridpesq.Next;
    if(ZQuery_gridpesq.Eof= True)Then begin
    Excel.Cells[a, 4] := '=d2+d1';//aqui vai a soma do valor total
    Excel.Cells[a, 3] := 'Total: ';
    end
    end;
   // excel.Workbooks[1].Saveas('C:\a.XLS');
except
showmessage('Ocorreu erro ao executar a transferência');
end;
end;

Utilizando dessa maneira, ele exporta e soma bunitinho, o problema é que a soma fica sempre na mesma linha, se tiver na linha três e a conta tiver duas linhas, aí beleza, agora, se a conta tiver 5 linhas, ela fica por cima do valor total, teria como fazer para o valor total ir acompanhando as linhas tipo termina os produtos, duas linhas depois aparece a soma total, se alguém puder me ajudar eu agradeço, no excel ou se tiver uma idéia mais fácil, tipo exportar para txt com valor de soma total, eu agradeço.

Valeu

Editado Janeiro 21, 2008 por João Paulo Taraciuk

[vms]

cara eu uso este componente para exportar para .xls , .txt e imprimir

mas so se seus dados estiver em um dbgrid

você seta o dbgrid, e na propriedade FPrintFileName voce coloca a extenção GRID.xls, GRID.txt

PrtGrid1.SaveToFile//salvar

PrtGrid1.Print//imprimi

ver se isso serve. valeu!!!

unit Prtgrid;

{ Original de Paul Rice }

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, DBGrids, DB, Printers, ExtCtrls, Grids;

const
  MaxPages = 1000;
  MaxCols = 100;

type
   TPageNumberPos = (pnNone,  pnTopLeft, pnTopCenter, pnTopRight,
                     pnBotLeft, pnBotCenter, pnBotRight);

   TPrtGrid = class(TComponent)
   private
      FFullPage: Boolean;
      OutFileName : TFileName;
      FDBGrid: TDBGrid;
      FTitleFont: TFont;
      FColHeaderFont: TFont;
      FColScale: integer;
      FLinesFont: TFont;
      FTitleAlign: TAlignment;
      FOrientation: TPrinterOrientation;
      FPageNLabel: String;
      FDateLabel: String;
      FPageNPos: TPageNumberPos;
      FDatePos: TPageNumberPos;
      FPrintFileName: String;
      FPrintFileDir: String;
      FTitle: String;
      FPrintMgrTitle: String;
      FirstRecordY: longint;
      DetailLineCharWidth: longint;
      DetailLineCharHeight: longint;
      RecCounter: longint;
      FPrintToFile: boolean;
      PrinterPageNo: longint;
      FFromPage: longint;
      FEndPage: longint;
      NPositions: integer;
      FTopMargin: integer;
      FBottomMargin: integer;
      FLeftMargin: integer;
      FRightMargin: integer;
      Positions: array[1..MaxCols]of longint;
      FColLines: boolean;
      FRowLines: boolean;
      FBorder: boolean;
      FHorizGap: integer;
      FVertGap: integer;
      procedure WriteAllToFile;
      procedure SetTitleFont(Value: TFont);
      procedure SetColHeaderFont(Value: TFont);
      procedure SetLinesFont(Value: TFont);
      procedure SetDBGrid(Value: TDBGrid);
      function GetDBGrid: TDBGrid;
      procedure SetPrintMgrTitle(const TmpStr: String);
      function GetPrintMgrTitle: String;
      function ColHeaderWidth(const ColHeaderStr: String): longint;
      function ColHeaderHeight: longint;
      procedure CalcPrinterPositions;
      function SetAlign(align:TAlignment; Left, Right: longint): longint;
      function SetPagePosX(PagePos: TPageNumberPos;
                           Left, Right: longint): longint;
      function SetPagePosY(PagePos: TPageNumberPos;
                           Top, Bottom: longint): longint;
      function PrepareAlign(Field: TField; Col: integer): longint;
      procedure WriteTitleToPrinter;
      procedure WriteColHdrsToPrinter(PosY: longint);
      procedure WriteRecordToPrinter;
      procedure PageJump;
      function RealWidth: longint;
      function AllPageFilled: boolean;
      procedure SetPixelsPerInch;
      function GetOrientation : TPrinterOrientation;
      procedure InitializePrinter;
   protected
      procedure SetName(const Value: TComponentName); override;
   public
      constructor Create(AOwner:TComponent); override;
      destructor Destroy; override;
      procedure Print;
      procedure PrintDialog;
      procedure SaveToFile;
   published
      property LeftMargin: integer read FLeftMargin write FLeftMargin;
      property TopMargin: integer read FTopMargin write FTopMargin;
      property RightMargin: integer read FRightMargin write FRightMargin;
      property BottomMargin: integer read FBottomMargin
                                     write FBottomMargin;
      property ColHeaderFont: TFont read FColHeaderFont
                                    write SetColHeaderFont;
      property ColScale: integer read FColScale write FColScale;  //*tj* added
      property TitleFont: TFont read FTitleFont write SetTitleFont;
      property LinesFont: TFont read FLinesFont write SetLinesFont;
      property DBGrid: TDBGrid read GetDBGrid write SetDBGrid;
      property PrintMgrTitle: String read GetPrintMgrTitle
                                     write SetPrintMgrTitle;
      property Title: String read FTitle write FTitle;
      property TitleAlignment: TAlignment read FTitleAlign
                                           write FTitleAlign;
      property Orientation: TPrinterOrientation read FOrientation
                                                write FOrientation;
      property PrintToFile: boolean read FPrintToFile write FPrintToFile;
      property FullPage: boolean read FFullPage write FFullPage;{RS 29.11.1996}
      property PrintFileName: String read FPrintFileName
                                     write FPrintFileName;
      property PrintFileDir: String read FPrintFileDir
                                     write FPrintFileDir;
      property FromPage: longint read FFromPage write FFromPage;
      property EndPage: longint read FEndPage write FEndPage;
      property Border: boolean read FBorder write FBorder;
      property ColLines: boolean read FColLines write FColLines;
      property RowLines: boolean read FRowLines write FRowLines;
      property HorizontalGap: integer read FHorizGap write FHorizGap;
      property VerticalGapPct: integer read FVertGap write FVertGap;
      property PageNumberPos: TPageNumberPos read FPageNPos
                                             write FPageNPos;
      property PageNumberLabel: String read FPageNLabel
                                       write FPageNLabel;
      property DatePos: TPageNumberPos read FDatePos write FDatePos;
      property DateLabel: String read FDateLabel write FDateLabel;
    end;

procedure Register;

implementation

var
  TextMetrics: TTextMetric;

function Max(a, b: longint): longint;
begin
  if a > b then Result := a else Result := b;
end;

function HeightScale(Value: longint; Pct: integer): longint;
begin
  if Pct > 100 then
    Pct := 100
  else
    if Pct < 0 then
      Pct := 0;
  if Pct = 0 then
    Result := Value
  else
    Result := Value + MulDiv(Value, Pct, 100);
end;

function CenterY(PosY, TextHt, Pct: longint): longint;
begin
  Result := PosY + (HeightScale(TextHt, Pct) - TextHt) div 2;
end;

constructor TPrtGrid.Create(AOwner:TComponent);
begin
  inherited Create(AOwner);
  FColHeaderFont := TFont.Create;
  FTitleFont := TFont.Create;
  FLinesFont := TFont.Create;
  FDBGrid := nil;
  FTitle := '';
  FPrintMgrTitle := '';
  RecCounter := 0;
  FHorizGap := 8;
  FVertGap := 40;
  FTopMargin := 60;
  FBottomMargin := 110;
  FLeftMargin := 30;
  FRightMargin := 30;
  FPrintToFile := False;
  FPrintFileName := 'GRID.LST';
  FPrintFileDir := 'C:\';
  FFullPage := false;
  FFromPage := 1;
  FEndPage := MaxPages;
  FBorder := False;
  FColLines := True;
  FRowLines := False;
  FTitleAlign := taCenter;
  FPageNPos := pnBotCenter;
  FPageNLabel := 'Page: ';
  FDatePos := pnTopRight;
  FDateLabel := '';
  FOrientation := poLandscape;
  FTitleFont.Name := 'Arial';
  FTitleFont.Style := [fsBold];
  FTitleFont.Size := 12;
  FColHeaderFont.Name := 'Arial';
  FColHeaderFont.Style := [fsBold];
  FColHeaderFont.Size := 10;
  FColScale := 100;
  FLinesFont.Name := 'Arial';
  FLinesFont.Style := [];
  FLinesFont.Size := 9;
end;

destructor TPrtGrid.Destroy;
begin
  FColHeaderFont.Free;
  FTitleFont.Free;
  FLinesFont.Free;
  inherited Destroy;
end;

procedure TPrtGrid.SetColHeaderFont(Value: TFont);
begin
  FColHeaderFont.Assign(Value);
end;

procedure TPrtGrid.SetTitleFont(Value: TFont);
begin
  FTitleFont.Assign(Value);
end;

procedure TPrtGrid.SetLinesFont(Value: TFont);
begin
  FLinesFont.Assign(Value);
end;

procedure TPrtGrid.SetDBGrid(Value: TDBGrid);
begin
  FDBGrid := Value;
end;

function TPrtGrid.GetDBGrid: TDBGrid;
begin
  Result := FDBGrid;
end;

procedure TPrtGrid.SetPrintMgrTitle(const TmpStr: String);
begin
  FPrintMgrTitle := TmpStr;
end;

function TPrtGrid.GetPrintMgrTitle: String;
begin
  Result := FPrintMgrTitle;
end;

procedure TPrtGrid.SetName(const Value: TComponentName);
var
  ChangeText: Boolean;
begin
  ChangeText := (Name = FPrintMgrTitle) and ((Owner = nil)
      or not (Owner is TPrtGrid)
      or not (csLoading in TPrtGrid(Owner).ComponentState));
  inherited SetName(Value);
  if ChangeText then
    FPrintMgrTitle := Value;
end;

procedure TPrtGrid.WriteAllToFile;
var
  OutFile: TextFile;
  BookMark1: TBookMark;
  FieldNo: longint;
  TmpStr: String;
begin
  if OutFileName = '' then
    if FPrintFileName = '' then
      OutFileName := 'C:\GRID.LST'
    else
      OutFileName := FPrintFileDir+FPrintFileName;
   {$I-}
   AssignFile(OutFile, OutFileName);
   Rewrite(OutFile);
   {$I+}
   if IOResult <> 0 then begin
     ShowMessage('Erro para abrir o arquivo :' + OutFileName);
     Exit;
   end;

   with FDBGrid.DataSource.DataSet do begin
     Writeln(OutFile, FTitle+'  Relatório');
      //Writeln(OutFile, FTitle+' - Importa para o Excel (Delimitado por Tab)');
     TmpStr := '';
      for FieldNo := 0 to FieldCount - 1 do
         if Fields[FieldNo].Visible then
            TmpStr := TmpStr + Fields[FieldNo].DisplayLabel + #9;
      WriteLn(OutFile, TmpStr);
      Screen.Cursor := crHourGlass;
      Bookmark1 := GetBookMark;
      try
        DisableControls;
        RecCounter := 0;
        First;
        while not EOF do begin
          TmpStr := '';
          for FieldNo := 0 to FieldCount - 1 do
            if Fields[FieldNo].Visible then
              TmpStr := TmpStr + Fields[FieldNo].DisplayText + #9;
          WriteLn(OutFile, TmpStr);
          Inc(RecCounter);
          Next;
        end;
      finally
        Screen.Cursor := crDefault;
        EnableControls;
        CloseFile(OutFile);
        GotoBookMark(BookMark1);
        FreeBookMark(BookMark1);
     end;
   end;
end;

function TPrtGrid.ColHeaderWidth(const ColHeaderStr: String): longint;
var
  tmpFont: TFont;
begin
  with Printer.Canvas do begin
    tmpFont := TFont.Create;
    tmpFont.Assign(Font);
    Font.Assign(FColHeaderFont);
    SetPixelsPerInch;
    Result := TextWidth(ColHeaderStr);
    Font.Assign(tmpFont);
    tmpFont.Free;
    SetPixelsPerInch;
  end;
end;

function TPrtGrid.ColHeaderHeight: longint;
var
  tmpFont: TFont;
begin
  with Printer.Canvas do begin
    tmpFont := TFont.Create;
    tmpFont.Assign(Font);
    Font.Assign(FColHeaderFont);
    SetPixelsPerInch;
    Result := HeightScale(TextHeight('M'), FVertGap);
    Font.Assign(tmpFont);
    SetPixelsPerInch;
    tmpFont.Free;
  end;
end;

procedure TPrtGrid.CalcPrinterPositions;
var
  ColWidth, FieldNo: longint;
begin
  if FBorder then
    Positions[1] := 1
  else
    Positions[1] := 0;

  NPositions := 0;
  with FDBGrid.DataSource.DataSet do
    for FieldNo := 0 to FieldCount - 1 do
      if Fields[FieldNo].Visible then begin
        inc(NPositions);
        ColWidth := Max(ColHeaderWidth(Fields[FieldNo].DisplayLabel),
                  (DetailLineCharWidth * Fields[FieldNo].DisplayWidth));
        Positions[NPositions + 1] := Positions[NPositions]
                  + ColWidth + 2*FHorizGap;
      end;
end;

function TPrtGrid.SetAlign(align: TAlignment; Left, Right:longint):longint;
var
  PosX: longint;
begin
  PosX := 0;
  with Printer.Canvas do begin
    case Align of
       taLeftJustify:
          begin
             SetTextAlign(Handle, TA_LEFT);
             PosX := Left + FHorizGap;
          end;
       taRightJustify:
          begin
             SetTextAlign(Handle, TA_RIGHT);
             PosX := Right - FHorizGap;
          end;
       taCenter:
          begin
             SetTextAlign(Handle, TA_CENTER);
             PosX := Left + Round((Right - Left) / 2);
          end;
      end;
   end;
   Result := PosX;
end;

function TPrtGrid.SetPagePosX(PagePos: TPageNumberPos; Left, Right: longint): longint;
var
   PosX: longint;
begin
   PosX := 0;
   with Printer.Canvas do begin
     case PagePos of
        pnTopLeft, pnBotLeft:
           begin
              SetTextAlign(Handle, TA_LEFT);
              PosX := Left + FHorizGap;
           end;
        pnTopRight, pnBotRight:
           begin
              SetTextAlign(Handle, TA_RIGHT);
              PosX := Right - FHorizGap;
           end;
        pnTopCenter, pnBotCenter:
           begin
              SetTextAlign(Handle, TA_CENTER);
              PosX := Left + Round((Right - Left)/2);
           end;
     end;
  end;
  Result := PosX;
end;

function TPrtGrid.SetPagePosY(PagePos: TPageNumberPos; Top, Bottom: longint): longint;
var
   PosY: longint;
begin
   case PagePos of
      pnBotLeft, pnBotCenter, pnBotRight:
         begin
            PosY := Bottom;
         end;
   else
      PosY := Top;
   end;
   Result := PosY;
end;

function TPrtGrid.PrepareAlign(Field:TField; Col:integer): longint;
begin
   Result := SetAlign(Field.Alignment, Positions[col], Positions[col + 1]);
end;

procedure TPrtGrid.WriteTitleToPrinter;
var
  PosX, PosY, FieldNo, tmpColHeaderHeight: longint;
  TmpFont: TFont;
  tmpFontCreated: boolean;
begin
  if (PrinterPageNo >= FFromPage) and (PrinterPageNo <= FEndPage) then
    with Printer.Canvas do begin
      tmpColHeaderHeight := ColHeaderHeight;
      tmpFont := TFont.Create;
      if (FTitle <> '') or (FDatePos <> pnNone) or (FPageNPos <> pnNone) then begin
        tmpFont.Assign(Font);
        Font.Assign(FTitleFont);
        SetPixelsPerInch;
        tmpFontCreated := True;
      end
      else
        tmpFontCreated := False;

      if FDatePos <> pnNone then begin
        if FDateLabel = '' then
           FDateLabel := FormatDateTime('mmm d, yyyy',SysUtils.Date);
        PosX := SetPagePosX(FDatePos, FLeftMargin, FLeftMargin + RealWidth);
        PosY := SetPagePosY(FDatePos, FTopMargin, Printer.PageHeight - FBottomMargin);
        TextOut(PosX, PosY, FDateLabel);
      end;

      if FTitle <> '' then begin
        PosX := SetAlign(FTitleAlign, FLeftMargin, FLeftMargin + RealWidth);
        TextOut(PosX, FTopMargin, FTitle);
      end;

      if FPageNPos <> pnNone then begin
        PosX := SetPagePosX(FPageNPos, FLeftMargin, FLeftMargin + RealWidth);
        PosY := SetPagePosY(FPageNPos, FTopMargin, Printer.PageHeight - FBottomMargin + 8);
        TextOut(PosX, PosY, FPageNLabel + IntToStr(PrinterPageNo));
      end;

      if (FTitle <> '') or (FDatePos in [pnTopLeft, pnTopCenter, pnTopRight])
         or (FPageNPos in [pnTopLeft, pnTopCenter, pnTopRight]) then
        FirstRecordY := FTopMargin + HeightScale(TextHeight('M'), FVertGap) + tmpColHeaderHeight
      else
        FirstRecordY := FTopMargin + tmpColHeaderHeight;

      if tmpFontCreated then begin
        Font.Assign(tmpFont);
        SetPixelsPerInch;
      end;
      tmpFont.Free;

      if FFullPage then
        if FColLines then
           for FieldNo := 2 to NPositions do begin
              MoveTo(FLeftMargin + Positions[FieldNo], FirstRecordY);
              LineTo(FLeftMargin + Positions[FieldNo], Printer.PageHeight - FBottomMargin);
           end;

      if dgTitles in FDBGrid.Options then
         WriteColHdrsToPrinter(FirstRecordY - tmpColHeaderHeight);
   end;
end;

procedure TPrtGrid.WriteColHdrsToPrinter(PosY: longint);
var
  Col, PosX:  longint;
  DSrcFld: longint;
  TmpFont: TFont;
  Rect: TRect;
begin
  with FDBGrid.DataSource.DataSet, Printer.Canvas do begin
    tmpFont := TFont.Create;
    tmpFont.Assign(Font);
    Font.Assign(FColHeaderFont);
    SetPixelsPerInch;
    Rect.top := CenterY(PosY, TextHeight('M'), 2*FVertGap);
    Rect.bottom := FirstRecordY+((RecCounter + 1) * TextHeight('M'));
    Col := 0;
    for DSrcFld := 0 to FieldCount - 1 do begin
      if Fields[DSrcFld].Visible then begin
        inc(Col);
        PosX := FLeftMargin + PrepareAlign(Fields[DSrcFld], Col);
        Rect.left := FLeftMargin + Positions[Col] + FHorizGap;
        Rect.right := FLeftMargin + Positions[Col+1] - FHorizGap;
        TextRect(Rect, PosX, Rect.top, Fields[DSrcFld].DisplayLabel);
      end;
    end;
    Moveto(FLeftMargin, FirstRecordY);
    Lineto(FLeftMargin + RealWidth, FirstRecordY);
    Font.Assign(tmpFont);
    SetPixelsPerInch;
    tmpFont.Free;
   end;
end;

procedure TPrtGrid.WriteRecordToPrinter;
var
  Col, PosX, PosY, FieldNo: longint;
  DSrcFld: longint;
  tmpFont: TFont;
  Rect: TRect;
begin
  if (PrinterPageNo >= FFromPage) and (PrinterPageNo <= FEndPage) then
    with FDBGrid.DataSource.DataSet, Printer.Canvas do begin
      tmpFont := TFont.Create;
      tmpFont.Assign(Font);
      Font.Assign(FLinesFont);
      SetPixelsPerInch;
      Col := 0;
      PosY := FirstRecordY + RecCounter * DetailLineCharHeight;
      Rect.top := CenterY(PosY, TextHeight('M'), FVertGap);
      Rect.bottom:=FirstRecordY+((RecCounter+1) * DetailLineCharHeight);
      for DSrcFld := 0 to FieldCount - 1 do begin
         if Fields[DSrcFld].Visible then begin
            inc(Col);
            PosX := FLeftMargin + PrepareAlign(Fields[DSrcFld], Col);
            Rect.left := FLeftMargin + Positions[Col] + FHorizGap;
            Rect.right := FLeftMargin + Positions[Col+1] - FHorizGap;
            TextRect(Rect, PosX, Rect.top, Fields[DSrcFld].DisplayText);
         end;
      end;

      if FRowLines then begin
        MoveTo(FLeftMargin, PosY);
        LineTo(FLeftMargin + RealWidth, PosY);
      end;

      if not FFullPage then
        if FColLines then
          for FieldNo := 2 to NPositions do begin
            MoveTo(FLeftMargin + Positions[FieldNo], FirstRecordY);
            LineTo(FLeftMargin + Positions[FieldNo], PosY + DetailLineCharHeight);
          end;

      Font.Assign(tmpFont);
      SetPixelsPerInch;
      tmpFont.Free;
    end;
end;

procedure TPrtGrid.PageJump;
begin
  RecCounter := 0;
  if (PrinterPageNo >= FFromPage) and (PrinterPageNo < FEndPage) then
    Printer.NewPage;
  inc(PrinterPageNo);
end;

function TPrtGrid.RealWidth: longint;
begin
  Result := Printer.PageWidth - FLeftMargin - FRightMargin;
end;

function TPrtGrid.AllPageFilled: boolean;
begin
  Result := (not FPrintToFile)
      and ((FirstRecordY + (RecCounter + 1) * DetailLineCharHeight)
            >= (Printer.PageHeight - FBottomMargin));
end;

procedure TPrtGrid.Print;
var
  BMark: TBookMark;
  PosY: longint;
  tmpStyle: TBrushStyle;
begin
  PosY := 0;
  if not Assigned(FDBGrid) then
    raise Exception.Create('Erro: DBGrid não associado.');
  if FPrintToFile then begin
    WriteAllToFile;
    Exit;
  end;
  InitializePrinter;
  with FDBGrid.DataSource.DataSet do begin
    BMark := GetBookMark;
    try
      DisableControls;
      RecCounter := 0;
      PrinterPageNo := 1;
      CalcPrinterPositions;
      if (Positions[NPositions + 1] > RealWidth) then
      begin
        if MessageDlg('Impressão muito larga para o papel, Configure as Margens.'+
           ' Aborta a impressão?', mtConfirmation, mbYesNoCancel, 0 )<>idNo then
        begin
          Printer.Abort;
          exit;
        end;
      end;
      Screen.Cursor := crHourGlass;
      First;
      while not EOF do begin
        if RecCounter = 0 then
           WriteTitleToPrinter;
        WriteRecordToPrinter;
        Inc(RecCounter);
        Next;
        if AllPageFilled then begin
          PageJump;
          if PrinterPageNo > FEndPage then break;
        end;
      end;
      if FRowLines then begin
        PosY := FirstRecordY + RecCounter * DetailLineCharHeight;
        Printer.Canvas.MoveTo(FLeftMargin, PosY);
        Printer.Canvas.LineTo(FLeftMargin + RealWidth, PosY);
      end;
      if FBorder then begin
        tmpStyle:=Printer.Canvas.Brush.Style;
        Printer.Canvas.Brush.Style:=bsClear;
        if FullPage then
          Printer.Canvas.Rectangle(FLeftMargin, FirstRecordY - ColHeaderHeight,
              FLeftMargin + RealWidth, Printer.PageHeight - FBottomMargin)
        else
          Printer.Canvas.Rectangle(FLeftMargin, FirstRecordY - ColHeaderHeight,
              FLeftMargin + RealWidth, PosY);
          Printer.Canvas.Brush.Style:=tmpStyle;
      end;
    finally
      EnableControls;
      Screen.Cursor := crDefault;
      GotoBookMark(BMark);
      FreeBookMark(BMark);
      Printer.EndDoc;
    end;
  end;
end;

procedure TPrtGrid.PrintDialog;
begin
  with TPrintDialog.Create(Self) do begin
    try
      Options := [poPageNums, poPrintToFile, poWarning];
      MinPage := 1;
      MaxPage := MaxPages;
      FromPage := 1;
      ToPage := MaxPages;
      if Execute then begin
        if PrintRange = prPageNums then begin
          FFromPage := FromPage;
          FEndPage := EndPage;
        end;
        FOrientation:=GetOrientation;
        if PrintToFile then
          SaveToFile
        else begin
          FPrintToFile := false;
          Print;
        end;
      end;
    finally
      Free;
    end;
  end;
end;

procedure TPrtGrid.SaveToFile;
begin
  FPrintToFile := true;
  with TSaveDialog.Create(Self) do begin
    try
      Filter := 'List Files (*.LST)|*.LST|Any file(*.*)|*.*';
      if FPrintFileDir <> '' then InitialDir := FPrintFileDir;
      if FPrintFileName <> '' then begin
        FileName := FPrintFileName;
        Filter := Filter + '|This file (*' + ExtractFileExt(FileName) + ')|*'
            + ExtractFileExt(FileName);
        FilterIndex := 3;
      end;
      if Execute then begin
        FPrintFileDir := ExtractFilePath(FileName);
        FPrintFileName := ExtractFileName(FileName);
        OutFileName := FileName;
        Print;
      end;
    finally
      Free;
    end;
  end;
end;

procedure TPrtGrid.SetPixelsPerInch;
var
  FontSize: integer;
begin
  if not Printer.Printing then
    ShowMessage('Erro: BeginDoc não foi chamado antes do SetPixelsPerInch');
  FontSize:=Printer.Canvas.Font.Size;
  Printer.Canvas.Font.PixelsPerInch:=GetDeviceCaps(Printer.Handle,LOGPIXELSY);
  Printer.Canvas.Font.Size := FontSize;
  GetTextMetrics( Printer.Canvas.Handle,TextMetrics );
end;

function TPrtGrid.GetOrientation : TPrinterOrientation;
var
  FDevice, FDriver, FPort: PChar;
  FHandle: THandle;
  FDeviceMode: PDevMode;
begin
  result := poPortrait;
  GetMem (FDevice, 255);
  GetMem (FDriver, 255);
  GetMem (FPort, 255);
  Printer.GetPrinter (FDevice, FDriver, FPort, FHandle);
  if FHandle = 0 then begin
    Printer.PrinterIndex := Printer.PrinterIndex;
    Printer.GetPrinter (FDevice, FDriver, FPort, FHandle);
  end;
  if FHandle <> 0 then begin
    FDeviceMode := Ptr(FHandle);
    case FDeviceMode^.dmOrientation of
       dmOrient_Portrait:   result := poPortrait;
       dmOrient_Landscape:  result := poLandscape;
    else
       result := poLandscape;
    end;
  end
  else
     ShowMessage('Erro não consigo identificar o modo de saida');
  FreeMem (FDevice, 255);
  FreeMem (FDriver, 255);
  FreeMem (FPort, 255);
end;

procedure TPrtGrid.InitializePrinter;
begin
  Printer.Orientation := FOrientation;
  Printer.BeginDoc;
  Printer.Title := FPrintMgrTitle;
  Printer.Canvas.Font.Assign(FLinesFont);
  SetPixelsPerInch;
  FVertGap:= Trunc(TextMetrics.tmHeight * 0.8);
  FHorizGap:= TextMetrics.tmMaxCharWidth div 4;
  DetailLineCharHeight := HeightScale(TextMetrics.tmHeight,FVertGap);
  DetailLineCharWidth := TextMetrics.tmMaxCharWidth;
  if (FColScale <> 100) and (FColScale > 0) and (FColScale < 500) then
    DetailLineCharWidth := 1+Trunc(DetailLineCharWidth * ColScale / 100);
end;

procedure Register;
begin
  RegisterComponents('Data Controls', [TPrtGrid]);
end;

end.

Editado Janeiro 18, 2008 por Micheus
Substituida tag QUOTE por CODE

[Micheus]

(...) o problema é que a soma fica sempre na mesma linha, se tiver na linha três e a conta tiver duas linhas, aí beleza, agora, se a conta tiver 5 linhas, ela fica por cima do valor total, teria como fazer para o valor total ir acompanhando as linhas tipo termina os produtos, duas linhas depois aparece a soma total

João, acho que é apenas um problema de "lógica" com seu procedimento.

Experimente deste modo e leia os comentários que coloquei no seu código alterado:

procedure Tfrm_pedidos.Button3Click(Sender: TObject);
var 
  i :integer;
  excel :variant;
begin
  try
    excel := CreateOleObject('excel.application');
    if not Excel.Application.Visible then
      Excel.Application.Visible := true;
    Excel.WorkBooks.Add;

  // Cabeçalho da sua tabela - linha 1
    Excel.Cells[1, 1] := 'Descricao';
    Excel.Cells[1, 2] := 'Qtd.';
    Excel.Cells[1, 3] := 'Vlr. Unit');
    Excel.Cells[1, 4] := 'Vlr. Total';

    i:=2;  // dados são colocados a partir da linha 2
    ZQuery_gridpesq.First;
    While not .ZQuery_gridpesq.Eof do
    begin
      Excel.Cells[i, 1] := ZQuery_gridpesq.FieldbyName('descricao').asString;
      Excel.Cells[i, 2] := ZQuery_gridpesq.FieldbyName('quantidade').asString;
      Excel.Cells[i, 3] := ZQuery_gridpesq.FieldbyName('valor_unit').AsFloat;
      Excel.Cells[i, 4] := ZQuery_gridpesq.FieldbyName('valor_total').AsFloat;
      inc(i);
      ZQuery_gridpesq.Next;
    end;
   // ao sair do loop, você já terá encontrado o EOF do dataset
   // e o valor de "i" será o da linha seguinte ao do último valor.

   // Inicializa a fórmula 2 linhas após a última 
   // com dados do dataset. 
    Excel.Cells[i +1, 3] := 'Total: ';
   // inicializamos a fórmula dinamicamente para apontar para o 
   // segmento da 2ª linha até a última preenchida (valor final de "i")
    Excel.Cells[i +1, 4] := Format('=SOMA(D2:D%d)', [i]);
   // grava arquivo excel
    excel.Workbooks[1].Saveas('C:\a.XLS');
  except
    showmessage('Ocorreu erro ao executar a transferência');
  end;
end;

O componente que o vms postou é bem interessante, porém não me parece que ele exporte totais, já que em DBGrid não existe esta linha para ser exportada. Talvez o colega vms possa dar alguma dica a esse respeito respeito.

Abraços

[João Paulo Taraciuk]

Antes de mais nada, obrigado pela ajuda, e testando o código do Micheus, ele funciona legal, porém não faz o cálculo da soma total no excel, agora, se eu clico em cima da célula onde seria o local da soma total, aparece a função da maneira correta, como tem que ser, assim, se tem duas linhas para calcular, aparece a fórmula =SOMA(D2:D4) que deveria fazer o cálculo, e a planilha é salva dessa maneira, porém, se eu simplesmente clico em cima da célula onde está a fórmula e dou um enter, o excel faz o cálculo certinho, aí, quebrando pensando um pouco por aqui, eu mostro o valor total da soma em um Edit, na tela de pedidos, aí eu coloquei dessa maneira o código

Excel.Cells[i +1, 4] :=  Format((total_pedido.Text), [i]);

Aí ele mostra o valor total, mas mostra como se fosse texto, se tivesse como converter para número seria ótimo, mas dessa maneira já mostra o que interessa, que é o valor total

Obrigado pela ajuda, vocês tem me ajudado muito nesses dois meses de programador, Valeu !!!

[Micheus]

testando o código do Micheus, ele funciona legal, porém não faz o cálculo da soma total no excel, agora, se eu clico em cima da célula onde seria o local da soma total, aparece a função da maneira correta, como tem que ser, assim, se tem duas linhas para calcular, aparece a fórmula =SOMA(D2:D4) que deveria fazer o cálculo, e a planilha é salva dessa maneira, porém, se eu simplesmente clico em cima da célula onde está a fórmula e dou um enter, o excel faz o cálculo certinho

Que sacanagem... :(

Aí ele mostra o valor total, mas mostra como se fosse texto, se tivesse como converter para número seria ótimo, mas dessa maneira já mostra o que interessa, que é o valor total

utiliza a propriedade FormatNumber antes da atribuição:

Excel.Cells[i +1, 4].NumberFormat := '#.##0,00';

só tem que observar que o separador de decimal e milhar são os definidos na configuração local do Windows, logo, é conveniente montar esta máscara usando o formato das configurações do usuário e não o formato como coloquei (o padrão americano, seria #,##0.00).

Abraços

[João Paulo Taraciuk]

Grande Micheus, funcionou aqui, obrigado!!!

Té mais.