寻Delphi5控件（能直接将Tquery或TTable中的数据集输出成Word及Excel格式）

[lifeng]

[kxy]

Delphi5\Demos\Activex\Oleauto\SrvComp\Word
有一个例子,自己写也不麻烦呀,找控件干吗?

[z_rainman]

利用delphi 5菜单中的project/import type library将word和excel的类型库引入，
通过ole技术自己编写吧
参考书：《delphi 4 编程技术内幕》

[lixq]

我也想要。

[chenjian]

下面给你一个较简单的源代码，用TQuery和TTable也就很简单了
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, OleServer, Excel97, ExtCtrls, QuickRpt, Db, DBTables;

type
TForm1 = class(TForm);
Button1: TButton;
Label1: TLabel;
Label2: TLabel;
procedure FormShow(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
xlApp: Variant;
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

uses
ComObj;

{$R *.DFM}

procedure TForm1.FormShow(Sender: TObject);
begin
//
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
//
end;

procedure TForm1.Button1Click(Sender: TObject);
var
i, j: integer;
begin
xlApp := CreateOleObject('Excel.Application');
xlApp.Visible := True;
xlApp.Workbooks.Add(EmptyParam); // xlWBatWorkSheet
xlApp.Workbooks[1].WorkSheets[1].Name := '乘法表';
// xlApp.Workbooks[1].Title := 'XXXX';
for i:=1 to 200 do
if i mod 2 = 0 then
begin
xlApp.Workbooks[1].WorkSheets['乘法表'].Columns[i].Font.Size := 10;
xlApp.Workbooks[1].WorkSheets['乘法表'].Columns[i].Font.Color := clBlue;
xlApp.Workbooks[1].WorkSheets['乘法表'].Columns[i].Font.Name := '宋体';
end
else if i mod 2 = 1 then
begin
xlApp.Workbooks[1].WorkSheets['乘法表'].Columns[i].Font.Size := 10;
xlApp.Workbooks[1].WorkSheets['乘法表'].Columns[i].Font.Color := clRed;
xlApp.Workbooks[1].WorkSheets['乘法表'].Columns[i].Font.Name := '宋体';
end;
for i:=1 to 200 do
for j:=1 to 200 do
// xlApp.Workbooks[1].WorkSheets['mmmm'].Cells[i,j] := 20;
if (j<=i) then
xlApp.Workbooks[1].WorkSheets['乘法表'].Cells[i,j] := IntToStr(j)+'*'+IntToStr(i)+'='+IntToStr(i*j);
// for i:=1 to 20 do
// xlApp.Workbooks[1].WorkSheets['mmmm'].Cells[21,i] := '=sum(A1:A20)';

xlApp.Workbooks[1].WorkSheets[2].Activate;
// xlApp.Workbooks[1].WorkSheets[2].Columns[1].Name := 'XXX';
xlApp.Workbooks[1].WorkSheets[2].Range['A1:F10'].Borders.LineStyle := xlContinuous;
xlApp.Workbooks[1].WorkSheets[2].Range['A1:F10'].Font.Size := 11;
xlApp.Workbooks[1].WorkSheets[2].Range['A1:F10'].Font.Color := clBlue;
xlApp.Workbooks[1].WorkSheets[2].Range['A1:C10'].Font.Bold := True;
end;

end.

[Hank]

下面提供的代码分别针对Word及Excel，你可以直接使用，也可以写一个类。
*****更多函数请参考MSDN中的OLE部分！

//**********具体代码**********//
unit Fasly;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, OleServer, Db, Mask, DBCtrls, Grids, DBTables;

type
TForm3 = class(TForm)
Button1: TButton;
Edit1: TEdit;
Button2: TButton;
SaveDialog1: TSaveDialog;
Table1: TTable;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form3: TForm3;

implementation

uses ComObj;

{$R *.DFM}

procedure TForm3.Button1Click(Sender: TObject);
var MSWord:Variant;
i,j:Integer;
begin
SaveDialog1.Filter:='*.DOC|*.DOC';
SaveDialog1.DefaultExt:='DOC';
if SaveDialog1.Execute then
begin
MSWord:=CreateOLEObject('Word.Application');
MSWord.Documents.Open(FileName:=SaveDialog1.FileName,ReadOnly:=False);
MSWord.Visible:=False;
MSWord.ActiveDocument.Range(Start:=0,End:=0);
Table1.Open;
j:=Table1.RecordCount;
Table1.First;
for i:=1 to j do
begin
MSWord.ActiveDocument.Range.InsertAfter(Text:=Table1.FieldByName('CODE').AsString+Table1.FieldByName('COLOR').AsString+Chr(13));
Table1.Next;
end;
MSWord.Documents.Close;
end;
end;

procedure TForm3.Button2Click(Sender: TObject);
var MSExcel:Variant;
i,j:Integer;
begin
SaveDialog1.Filter:='*.XLS|*.XLS';
SaveDialog1.DefaultExt:='XLS';
if SaveDialog1.Execute then
begin
MSExcel:=CreateOLEObject('Excel.Application');
MSExcel.WorkBooks.Add;
MSExcel.Visible:=False;
Table1.Open;
j:=Table1.RecordCount;
Table1.First;
for i:=1 to j do
begin
MSExcel.Cells[i,1].Value:=Table1.FieldByName('CODE').AsString;
MSExcel.Cells[i,2].Value:=Table1.FieldByName('COLOR').AsString;
Table1.Next;
end;
MSExcel.ActiveWorkBook.SaveAs(SaveDialog1.FileName);
MSExcel.ActiveWorkBook.Saved:=True;
MSExcel.Quit;
end;
end;

end.

[alin]

给[e-mail]写信，他有一个，会给你的