Exportar dados de uma tabela para o Word usando Delphi

Esta é uma dica para iniciantes (para fins didáticos), funciona para o Word 2000 e Word XP.


unit ExportaDadosWord;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, DB, Grids, DBGrids, ADODB, StdCtrls, Buttons, OleServer,
  Word2000, WordXP;

type
  TForm1 = class(TForm)
    Conn: TADOConnection;
    q: TADOQuery;
    DBGrid1: TDBGrid;
    DataSource1: TDataSource;
    BitBtn1: TBitBtn;
    Word: TWordApplication;
    qShipCountry: TWideStringField;
    procedure BitBtn1Click(Sender: TObject);


  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  numcampos, numRegistros   : integer;

implementation

{$R *.dfm}


procedure TForm1.BitBtn1Click(Sender: TObject);
var
  AjusteautomaticoColunas, oleNumero, oleUnidade : oleVariant;
  Linha, Coluna : integer;
  n             : integer;
begin
  numcampos := q.FieldCount;
  q.RecordCount;
  AjusteautomaticoColunas := true;
  oleNumero               := 1;
  oleUnidade              := wdcell;
  linha                   := 1;
  coluna                  := numcampos;

  // define parametros do word
  Word.WindowState := wdWindowStateNormal;
  Word.Caption     := ' Exportacao de dados delphi';
  word.Visible     := true;

  // abre um novo documento do word
  word.Documents.Add(EmptyParam, EmptyParam, EmptyParam, EmptyParam);

  // define fontr do documento
  word.Selection.Font.Name := 'Arial';
  word.Selection.Font.Size := 10;
  word.Selection.Font.Bold := 0;
  word.Selection.Font.Color := RGB(0, 0, 255);

  //cria uma tabela no word
  word.Selection.Tables.Add(Word.Selection.Range, Linha, Coluna, EmptyParam, AjusteautomaticoColunas);

  for n := 0 to numcampos - 1 do
  begin
    word.Selection.TypeText(q.Fields[n].DisplayLabel);
    word.Selection.MoveRight(oleUnidade, oleNumero, EmptyParam);
    //showmessage(IntToStr(n));
    //showmessage(IntToStr(numcampos));
  end;

  q.First;
  while not q.Eof do
  begin
    for n:= 0 to numcampos - 1 do
    begin
      if (q.Fields[n].Value = null) or (q.Fields[n].DataType = ftBlob) then
         word.Selection.TypeText('0');
      if (q.Fields[n].Value <> NULL) AND (q.Fields[n].DataType <> ftBlob) then
         word.Selection.TypeText(q.Fields[n].Value);
         word.Selection.MoveRight(oleUnidade, oleNumero, EmptyParam);

        //showmessage(IntToStr(n));
       // showmessage(IntToStr(numcampos));
    end;
  q.Next;
  end;

end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  q.Open;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  q.Close;
end;

end.

Por : Fabio Correa