Title: How to export data from a query to Word
The end user of your (database program) eventually wants the data in a nice report he/she can edit. There are report generators but most likely the user knows only M$ Word, don't even try talkin about Crystal Reports or similar.
The programmer not familiar with VB or VBA has to learn a little of VB to accomplish this. Fortunately we can expose the VB commands with the Macro Recorder and translate them to Delphi without loosing to much sleep over Visual Basic.
This FAQ is the Word equivalent of
FAQ102-1562
How to export data to Excel
Objective:
Export data from a query (DBDEMOS table Orders.db) to Word
The query will retrive 10 fields, the total value of the order is greater then $15000, put all the record in a table, and write it to a Word file.
The SQL property of the TQuery:
Select OrderNo, CustNo, SaleDate, EmpNo, ShipVIA, Terms, ItemsTotal, TaxRate, Freight, Amountpaid FROM "orders.db" Orders where ItemsTotal 15000
First we have to prepare the word layout
Open Word, go to Tools -- Macro -- Record new macro
We will:
1) Set the page layout out to portrait to create space for the table
2) Prepare the header by typing in the 10 column names separated by ;
after the last name type in
enter
3) Fill in two rows of data separated by ; (remember to type in
enter
at the end of the row)
4) Chose
Select All
from the Edit menu
5) go to Table -- Convert -- Text to Table
6) Indicate ; as the separator and use AutoFormat -- Table Contemporary
7) Apply formating using tab and Table -- select Column to align the numbers to the right
8) Center the column titles with Table -- select Row
9) Stop recording
After that the macro editor is used to visualize the VB commands.
It should look like this:
CODE
Sub ExpWord()
'
' ExpWord Macro
' Macro recorded 8/8/2005 by Steven
'
With ActiveDocument.Styles(wdStyleNormal).Font
If .NameFarEast = .NameAscii Then
.NameAscii = ""
End If
.NameFarEast = ""
End With
{ step 1}
With ActiveDocument.PageSetup
.LineNumbering.Active = False
.Orientation = wdOrientLandscape
.TopMargin = InchesToPoints(1.25)
.BottomMargin = InchesToPoints(1.25)
.LeftMargin = InchesToPoints(1)
.RightMargin = InchesToPoints(1)
.Gutter = InchesToPoints(0)
.HeaderDistance = InchesToPoints(0.5)
.FooterDistance = InchesToPoints(0.5)
.PageWidth = InchesToPoints(11)
.PageHeight = InchesToPoints(8.5)
.FirstPageTray = wdPrinterDefaultBin
.OtherPagesTray = wdPrinterDefaultBin
.SectionStart = wdSectionNewPage
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.VerticalAlignment = wdAlignVerticalTop
.SuppressEndnotes = False
.MirrorMargins = False
etc.....
End With
{Step 2}
Selection.TypeText Text:= _
"Order No;Customer No;Sale date;Emp No;Shipment;Terms;Total;Tax "
Selection.TypeText Text:="Rate;Freight;Paid"
{Step 3}
Selection.TypeParagraph
Selection.TypeText Text:= _
"100;200;4/9/2005;300;Agent;FOB;20000;0.25;500;18000"
Selection.TypeParagraph
Selection.TypeText Text:="104;205;5/8/2005;302;DHL;15005;0;100;4000"
Selection.MoveLeft Unit:=wdCharacter, Count:=17
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="Net 30;"
Selection.MoveRight Unit:=wdCharacter, Count:=17
Selection.TypeParagraph
{ Step 4....}
Selection.WholeStory
Application.DefaultTableSeparator = ";"
Selection.ConvertToTable Separator:=wdSeparateByDefaultListSeparator, _
NumColumns:=10, NumRows:=3, AutoFitBehavior:=wdAutoFitFixed
With Selection.Tables(1)
.Style = "Table Contemporary"
.ApplyStyleHeadingRows = True
.ApplyStyleLastRow = True
.ApplyStyleFirstColumn = True
.ApplyStyleLastColumn = True
End With
Selection.Tables(1).Columns(2).SetWidth ColumnWidth:=77.55, RulerStyle:= _
wdAdjustNone
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.SelectColumn
Selection.ParagraphFormat.Alignment = wdAlignParagraphRight
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.SelectColumn
Selection.ParagraphFormat.Alignment = wdAlignParagraphRight
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.SelectColumn
Selection.ParagraphFormat.Alignment = wdAlignParagraphRight
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.SelectColumn
Selection.ParagraphFormat.Alignment = wdAlignParagraphRight
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.SelectColumn
Selection.ParagraphFormat.Alignment = wdAlignParagraphRight
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.SelectColumn
Selection.ParagraphFormat.Alignment = wdAlignParagraphRight
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.SelectColumn
Selection.ParagraphFormat.Alignment = wdAlignParagraphRight
Selection.MoveRight Unit:=wdCell
Selection.SelectRow
Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
End Sub
Ingredients for Delphi
1) A Tform of course
2) A Tquery, name it
qry
3) SaveDialog
4) TWordApplication (Servers Palette)
5) BitButton (you can put the Word icon in the glyph)
6) dbGrid, dbNavigator, datasource for comparison (yes I still stick by the BDE, just a matter of taste)
Right click the Query after typing in the SQL property:
Select OrderNo, CustNo, SaleDate, EmpNo, ShipVIA, Terms, ItemsTotal, TaxRate, Freight, Amountpaid FROM "orders.db" Orders where ItemsTotal 15000
to bring up the
Fields Editor
and bring in the fields on your form
The Delphi code:
CODE
unit MainU;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, DBCtrls, Grids, DBGrids, DB, DBTables, Buttons,
OleServer, Word2000;
type
TForm1 = class(TForm)
DataSource1: TDataSource;
qry: TQuery;
qryOrderNo: TFloatField;
qryCustNo: TFloatField;
qryEmpNo: TIntegerField;
qrySaleDate: TDateTimeField;
qryShipVIA: TStringField;
qryTerms: TStringField;
qryItemsTotal: TCurrencyField;
qryTaxRate: TFloatField;
qryFreight: TCurrencyField;
qryAmountpaid: TCurrencyField;
DBGrid1: TDBGrid;
DBNavigator1: TDBNavigator;
WordApplication1: TWordApplication;
SpeedButton1: TSpeedButton;
SaveDialog1: TSaveDialog;
procedure SpeedButton1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.SpeedButton1Click(Sender: TObject);
Var
NumLines: integer;
CellMove, ParamTrue, ParamFalse: OleVariant;
Separator,NumRows,NumCols,TableFormat: OleVariant;
SaveFileName: OleVariant;
begin
With SaveDialog1 do
begin
FileName := ';
Filter:= 'Word Files|*.DOC;All Files|*.*';
Title:= 'Export to Word';
if Execute then
begin
qry.Close;
qry.Open;
with WordApplication1 do
Begin
Connect;
try
Documents.Add(EmptyParam,EmptyParam,Emptyparam,EmptyParam);
visible := true;
//Step 1, prepare the page layout
with ActiveDocument.PageSetup do
begin
LineNumbering.Active := 0;
Orientation := wdOrientLandscape;
TopMargin := InchesToPoints(1.25);
BottomMargin := InchesToPoints(1.25);
LeftMargin := InchesToPoints(1);
RightMargin := InchesToPoints(1);
Gutter := InchesToPoints(0);
HeaderDistance := InchesToPoints(0.5);
FooterDistance := InchesToPoints(0.5);
PageWidth := InchesToPoints(11);
PageHeight := InchesToPoints(8.5);
FirstPageTray := wdPrinterDefaultBin ;
OtherPagesTray := wdPrinterDefaultBin ;
SectionStart := wdSectionNewPage ;
OddAndEvenPagesHeaderFooter := 0 ;
DifferentFirstPageHeaderFooter := 0;
VerticalAlignment := wdAlignVerticalTop;
SuppressEndnotes := 0;
MirrorMargins := 0;
end; //with
//Step 2, Preparing the Header with column names
Selection.TypeText('Order #;Cust #;'+
'Sale Date;Emp #;Shipment;Terms;Total;'+
'Tax Rate;Freight;Paid');
//Step 3 Fill in the data from the query
Numlines := 1;
qry.First;
while not qry.Eof do
begin
Selection.TypeParagraph;
Selection.TypeText(qryOrderNo.AsString+';'+
qryCustNo.AsString +';'+
qrySaleDate.AsString +';'+
qryEmpNo.AsString +';'+
qryShipVia.Value +';'+
qryTerms.Value +';'+
qryItemsTotal.DisplayText +';'+
qryTaxrate.AsString +';'+
qryFreight.DisplayText +';'+
qryAmountPaid.DisplayText);
Inc(NumLines);
qry.Next;
end; //while
//Step 4 -- 6
Selection.WholeStory;
ParamTrue := True;
ParamFalse := False;
Separator:=wdSeparateByDefaultListSeparator;
NumRows := NumLines ;
NumCols:=10;
TableFormat := wdTableFormatContemporary;
Selection.ConvertToTable(Separator,NumRows,NumCols,EmptyParam,
TableFormat,EmptyParam,EmptyParam,EmptyParam,EmptyParam,
EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam,
EmptyParam, ParamTrue);
//Step 7
CellMove := wdCell;
NumCols := 1; //column 1
Selection.MoveRight(CellMove,NumCols,EmptyParam);
Selection.SelectColumn;
Selection.ParagraphFormat.Alignment := wdAlignParagraphRight;
NumCols:= 2; //column 2
Selection.MoveRight(CellMove,NumCols,EmptyParam);
Selection.SelectColumn;
Selection.ParagraphFormat.Alignment := wdAlignParagraphRight;
NumCols:= 3; //column4
Selection.MoveRight(CellMove,NumCols,EmptyParam);
Selection.SelectColumn;
Selection.ParagraphFormat.Alignment := wdAlignParagraphRight;
NumCols:= 4; //colum6
Selection.MoveRight(CellMove,NumCols,EmptyParam);
Selection.SelectColumn;
Selection.ParagraphFormat.Alignment := wdAlignParagraphRight;
NumCols:= 2; //column7
Selection.MoveRight(CellMove,NumCols,EmptyParam);
Selection.SelectColumn;
Selection.ParagraphFormat.Alignment := wdAlignParagraphRight;
Selection.MoveRight(CellMove,NumCols,EmptyParam);
Selection.SelectColumn;
Selection.ParagraphFormat.Alignment := wdAlignParagraphRight;
Selection.MoveRight(CellMove,NumCols,EmptyParam);
Selection.SelectColumn;
Selection.ParagraphFormat.Alignment := wdAlignParagraphRight;
Selection.MoveRight(CellMove,NumCols,EmptyParam);
Selection.SelectColumn;
Selection.ParagraphFormat.Alignment := wdAlignParagraphRight;
//selection of header
Selection.MoveRight(CellMove,EmptyParam,EmptyParam);
Selection.SelectRow;
Selection.ParagraphFormat.Alignment := wdAlignParagraphCenter;
Selection.Rows.HeadingFormat := wdToggle;
Quit;
finally
Disconnect;
end;
end;
end;
end;
end;
end.
Some remarks
1) Use the Tab character to move around in the table, when recording the macro
2) After a selection, to deselect press tab again. This means moving to the next column requires two tabs
CODE
NumCols:= 2;
Selection.MoveRight(CellMove,NumCols,EmptyParam);
3) VB doesn't have the boolean type we are familiar with:
.LineNumbering.Active = False
has the equivalent in Delphi:
LineNumbering.Active := 0;