Excel 文件输出(100分)

如何将Query或报表数据输出到Excel文件？

谢谢！！！！！！！

這種東東這儿太多了。
從Server控件組拉一下ExcelApplication控件。
var aSheet:Variant;
begin
EA1.Connect;
EA1.Visible[0]:=False;
EA1.Workbooks.Add(xlWBATWorkSheet,0);
asheet:=EA1.Worksheets.Item[1];
這是新增一個Excel文件
EA1.Connect;
EA1.Workbooks.Open('C:/yoursample.xls',EmptyParam,EmptyParam,EmptyParam,EmptyParam,
EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam,1);
EA1.Visible[0]:=False;
aSheet:=EA1.Worksheets.Item[1];
這是以一個文件為模板
PrnQuery.First;
i:=2;
while not PrnQuery.Eof do
begin
for j:=0 to PrnQuery.FieldCount-1 do
aSheet.Cells[i,j+1].Value:=PrnQuery.Fields[j].AsString;
PrnQuery.Next;
i:=i+1;
end;
SaveDialog.Execute;//拉一個SaveDialog控件
if SaveDialog.FileName<>'noname' then begin
aSheet.SaveAs(SaveDialog.FileName);//保存
ShowMessage('文件已保存為'+SaveDialog.FileName);
end;
aSheet.Application.Quit;
end;

如何改变Excle 如:A、B、C的名字
如：dbgrid1.displaylabel:='FULL_NAME'

用OLE的方法太慢
用F1BOOK1然后将数据存成
EXCEL格式
速度很快

还可以把EXCEL看作一个数据表，然后用SQL语句的插入语句，
直接向里插入数据，可在ODBC中建一个支持EXCEL的数据库，
一定可以的，很快的，
另外ADO也支持这么作。

算了，算了，好像很多人问这个问题，我贴一个控件吧。
{****************************************************
Copyright , 1999-2009 , AirSpy Tech . Co ., Ltd
FileName : OleExcel.Pas
Author : Tang Lu
Version : 1.0
Date : 1999/08/06
Description :
把一个表或者Query或者StringGrid中的数据保存到一个Execl文件中
Function List :
创建接口
procedure CreateExcelInstance;
把表内容放到Excel文件中
procedure TableToExcel( const Table: TTable );
把Query内容放到Excel文件中
procedure QueryToExcel( const Query: TQuery );
把StringGrid内容放到Excel文件中
procedure StringGridToExcel( const StringGrid: TStringGrid );
保存为Execl文件
procedure SaveToExcel( const FileName: String);
Demo:
调用实例如下：
OLEExcel1.CreateExcelInstance;
OLEExcel1.QuerytoExcel((CurRep.DataSet as TQuery));//tablename is你的表名
OLEExcel1.SaveToExcel(SaveDlg1.FileName);
1. --------
History: //历史修改纪录
<author> <time> <version> <desc>
Tanglu 1999/08/06 1.0 build this moudle
****************************************************}
unit OleExcel;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
comobj, DBTables, Grids;
type
TOLEExcel = class(TComponent)
private
FExcelCreated: Boolean;
FVisible: Boolean;
FExcel: Variant;
FWorkBook: Variant;
FWorkSheet: Variant;
FCellFont: TFont;
FTitleFont: TFont;
FFontChanged: Boolean;
FIgnoreFont: Boolean;
FFileName: TFileName;
procedure SetExcelCellFont(var Cell: Variant);
procedure SetExcelTitleFont(var Cell: Variant);
procedure GetTableColumnName(const Table: TTable; var Cell: Variant);
procedure GetQueryColumnName(const Query: TQuery; var Cell: Variant);
procedure GetFixedCols(const StringGrid: TStringGrid; var Cell: Variant);
procedure GetFixedRows(const StringGrid: TStringGrid; var Cell: Variant);
procedure GetStringGridBody(const StringGrid: TStringGrid; var Cell: Variant);
protected
procedure SetCellFont(NewFont: TFont);
procedure SetTitleFont(NewFont: TFont);
procedure SetVisible(DoShow: Boolean);
function GetCell(ACol, ARow: Integer): string;
procedure SetCell(ACol, ARow: Integer; const Value: string);

function GetDateCell(ACol, ARow: Integer): TDateTime;
procedure SetDateCell(ACol, ARow: Integer; const Value: TDateTime);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure CreateExcelInstance;
property Cell[ACol, ARow: Integer]: string read GetCell write SetCell;
property DateCell[ACol, ARow: Integer]: TDateTime read GetDateCell write SetDateCell;
function IsCreated: Boolean;
procedure TableToExcel(const Table: TTable);
procedure QueryToExcel(const Query: TQuery);
procedure StringGridToExcel(const StringGrid: TStringGrid);
procedure SaveToExcel(const FileName: string);
published
property TitleFont: TFont read FTitleFont write SetTitleFont;
property CellFont: TFont read FCellFont write SetCellFont;
property Visible: Boolean read FVisible write SetVisible;
property IgnoreFont: Boolean read FIgnoreFont write FIgnoreFont;
property FileName: TFileName read FFileName write FFileName;
end;

procedure Register;

implementation

constructor TOLEExcel.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FIgnoreFont := True;
FCellFont := TFont.Create;
FTitleFont := TFont.Create;
FExcelCreated := False;
FVisible := False;
FFontChanged := False;
end;

destructor TOLEExcel.Destroy;
begin
FCellFont.Free;
FTitleFont.Free;
inherited Destroy;
end;

procedure TOLEExcel.SetExcelCellFont(var Cell: Variant);
begin
if FIgnoreFont then exit;
with FCellFont do
begin
Cell.Font.Name := Name;
Cell.Font.Size := Size;
Cell.Font.Color := Color;
Cell.Font.Bold := fsBold in Style;
Cell.Font.Italic := fsItalic in Style;
Cell.Font.UnderLine := fsUnderline in Style;
Cell.Font.Strikethrough := fsStrikeout in Style;
end;
end;

procedure TOLEExcel.SetExcelTitleFont(var Cell: Variant);
begin
if FIgnoreFont then exit;
with FTitleFont do
begin
Cell.Font.Name := Name;
Cell.Font.Size := Size;
Cell.Font.Color := Color;
Cell.Font.Bold := fsBold in Style;
Cell.Font.Italic := fsItalic in Style;
Cell.Font.UnderLine := fsUnderline in Style;
Cell.Font.Strikethrough := fsStrikeout in Style;
end;
end;


procedure TOLEExcel.SetVisible(DoShow: Boolean);
begin
if not FExcelCreated then exit;
if DoShow then
FExcel.Visible := True
else
FExcel.Visible := False;
end;

function TOLEExcel.GetCell(ACol, ARow: Integer): string;
begin
if not FExcelCreated then exit;
result := FWorkSheet.Cells[ARow, ACol];
end;

procedure TOLEExcel.SetCell(ACol, ARow: Integer; const Value: string);
var
Cell: Variant;
begin
if not FExcelCreated then exit;
Cell := FWorkSheet.Cells[ARow, ACol];
SetExcelCellFont(Cell);
Cell.Value := Value;
end;


function TOLEExcel.GetDateCell(ACol, ARow: Integer): TDateTime;
begin
if not FExcelCreated then
begin
result := 0;
exit;
end;
result := StrToDateTime(FWorkSheet.Cells[ARow, ACol]);
end;

procedure TOLEExcel.SetDateCell(ACol, ARow: Integer; const Value: TDateTime);
var
Cell: Variant;
begin
if not FExcelCreated then exit;
Cell := FWorkSheet.Cells[ARow, ACol];
SetExcelCellFont(Cell);
Cell.Value := '''' + DateTimeToStr(Value);
end;

procedure TOLEExcel.CreateExcelInstance;
begin
try
FExcel := CreateOLEObject('Excel.Application');
FWorkBook := FExcel.WorkBooks.Add;
FWorkSheet := FWorkBook.WorkSheets.Add;
FExcelCreated := True;
except
FExcelCreated := False;
end;
end;

function TOLEExcel.IsCreated: Boolean;
begin
result := FExcelCreated;
end;

procedure TOLEExcel.SetTitleFont(NewFont: TFont);
begin
if NewFont <> FTitleFont then
FTitleFont.Assign(NewFont);
end;

procedure TOLEExcel.SetCellFont(NewFont: TFont);
begin
if NewFont <> FCellFont then
FCellFont.Assign(NewFont);
end;

procedure TOLEExcel.GetTableColumnName(const Table: TTable; var Cell: Variant);
var
Col: integer;
begin
for Col := 0 to Table.FieldCount - 1 do
begin
Cell := FWorkSheet.Cells[1, Col + 1];
SetExcelTitleFont(Cell);
Cell.Value := Table.Fields[Col].FieldName;
end;
end;

procedure TOLEExcel.TableToExcel(const Table: TTable);
var
Col, Row: LongInt;
Cell: Variant;
begin
if not FExcelCreated then exit;
if Table.Active = False then exit;

GetTableColumnName(Table, Cell);
Row := 2;
with Table do
begin
first;
while not EOF do
begin
for Col := 0 to FieldCount - 1 do
begin
Cell := FWorkSheet.Cells[Row, Col + 1];
SetExcelCellFont(Cell);
Cell.Value := Fields[Col].AsString;
end;
next;
Inc(Row);
end;
end;
end;


procedure TOLEExcel.GetQueryColumnName(const Query: TQuery; var Cell: Variant);
var
Col: integer;
begin
for Col := 0 to Query.FieldCount - 1 do
begin
Cell := FWorkSheet.Cells[1, Col + 1];
SetExcelTitleFont(Cell);
Cell.Value := Query.Fields[Col].FieldName;
end;
end;


procedure TOLEExcel.QueryToExcel(const Query: TQuery);
var
Col, Row: LongInt;
Cell: Variant;
begin
if not FExcelCreated then exit;
if Query.Active = False then exit;

GetQueryColumnName(Query, Cell);
Row := 2;
with Query do
begin
first;
while not EOF do
begin
for Col := 0 to FieldCount - 1 do
begin
Cell := FWorkSheet.Cells[Row, Col + 1];
SetExcelCellFont(Cell);
Cell.Value := Fields[Col].AsString;
end;
next;
Inc(Row);
end;
end;
end;

procedure TOLEExcel.GetFixedCols(const StringGrid: TStringGrid; var Cell: Variant);
var
Col, Row: LongInt;
begin
for Col := 0 to StringGrid.FixedCols - 1 do
for Row := 0 to StringGrid.RowCount - 1 do
begin
Cell := FWorkSheet.Cells[Row + 1, Col + 1];
SetExcelTitleFont(Cell);
Cell.Value := StringGrid.Cells[Col, Row];
end;
end;

procedure TOLEExcel.GetFixedRows(const StringGrid: TStringGrid; var Cell: Variant);
var
Col, Row: LongInt;
begin
for Row := 0 to StringGrid.FixedRows - 1 do
for Col := 0 to StringGrid.ColCount - 1 do
begin
Cell := FWorkSheet.Cells[Row + 1, Col + 1];
SetExcelTitleFont(Cell);
Cell.Value := StringGrid.Cells[Col, Row];
end;
end;

procedure TOLEExcel.GetStringGridBody(const StringGrid: TStringGrid; var Cell: Variant);
var
Col, Row, x, y: LongInt;
begin
Col := StringGrid.FixedCols;
Row := StringGrid.FixedRows;
for x := Row to StringGrid.RowCount - 1 do
for y := Col to StringGrid.ColCount - 1 do
begin
Cell := FWorkSheet.Cells[x + 1, y + 1];
SetExcelCellFont(Cell);
Cell.Value := StringGrid.Cells[y, x];
end;
end;

procedure TOLEExcel.StringGridToExcel(const StringGrid: TStringGrid);
var
Cell: Variant;
begin
if not FExcelCreated then exit;
GetFixedCols(StringGrid, Cell);
GetFixedRows(StringGrid, Cell);
GetStringGridBody(StringGrid, Cell);
end;

procedure TOLEExcel.SaveToExcel(const FileName: string);
begin
if not FExcelCreated then exit;
FWorkSheet.SaveAs(FileName);
end;

procedure Register;
begin
RegisterComponents('Tanglu', [TOLEExcel]);
end;

end.

我给你一段我们公司员工考核的代码：

begin
try
if ESumYear.Text='' then
begin
showmessage('请输入年度！ 如:2000');
abort;
end;
bXls:=True;
ExcelApp:=CreateOleObject('Excel.Application');
MyWorkBook:=CreateOleobject('Excel.Sheet');
except
on Exception do raise exception.Create('无法打开Xls文件，请确认已 经安装EXCEL')
end;
ExcelApp.Visible := true;

MyworkBook:=ExcelApp.workBooks.Add;

//在此处插入读数据库及写Excel文档的代码
//其中写Excel文档的关键语句如下：
Myworkbook.worksheets[1].range['A1:G1'].Merge(True);
Myworkbook.worksheets[1].range['A1:G2'].HorizontalAlignment := $FFFFEFF4;
MyWorkBook.WorkSheets[1].Cells[1,1].Value := '年终考核汇总表';

i := 2;
MyWorkBook.WorkSheets[1].Cells[i,1].Value := '员工编号';
MyWorkBook.WorkSheets[1].Cells[i,2].Value := '受评人姓名';
MyWorkBook.WorkSheets[1].Cells[i,3].Value := '部门编号';
MyWorkBook.WorkSheets[1].Cells[i,4].Value := '部门名称';
MyWorkBook.WorkSheets[1].Cells[i,5].Value := '到职日期';
MyWorkBook.WorkSheets[1].Cells[i,6].Value := '分数';
MyWorkBook.WorkSheets[1].Cells[i,7].Value := '年度';
Myworkbook.worksheets[1].Range['A1:G2'].Font.Color := clBlue;
Myworkbook.worksheets[1].Range['A1:G1'].Font.Name := '隶书';
Myworkbook.worksheets[1].Range['A1:G1'].Font.Size := 18;

i := 3;
with DM do
begin
QExcelMark.close;
QExcelMark.ParamByName('pYear').AsInteger:=strtoint(ESumYear.Text);
QExcelMark.open;
QExcelMark.First;
while not QExcelMark.eof do begin
MyWorkBook.WorkSheets[1].Cells[i,1].Value := QExcelMark.FieldByName('empNo').AsString;
MyWorkBook.WorkSheets[1].Cells[i,2].Value := QExcelMark.FieldByName('name').AsString;
MyWorkBook.WorkSheets[1].Cells[i,3].Value := QExcelMark.FieldByName('dptNo').AsString;
MyWorkBook.WorkSheets[1].Cells[i,4].Value := QExcelMark.FieldByName('dptName').AsString;
MyWorkBook.WorkSheets[1].Cells[i,5].Value := QExcelMark.FieldByName('dateStarted').Value;
MyWorkBook.WorkSheets[1].Cells[i,6].Value := QExcelMark.FieldByName('sumPoint').AsFloat;
MyWorkBook.WorkSheets[1].Cells[i,7].Value := QExcelMark.FieldByName('chkYear').Value;

QExcelMark.Next; Inc(i);
end;

end; // with DM do

多人接受答案了。

怎么着都可以，切看我这段例子。

unit Unyryc;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls;

type
TForm1 = class(TForm)
Label1: TLabel;
Image1: TImage;
Image2: TImage;
procedure FormActivate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

TcImage=class(TImage)
private
procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TcImage.CMMouseEnter(var Message: TMessage);
begin
Picture:=Form1.Image2.Picture;
end;

procedure TcImage.CMMouseLeave(var Message: TMessage);
begin
Picture:=Form1.Image1.Picture;
end;

procedure TForm1.FormActivate(Sender: TObject);
var
aa:TcImage;
n:integer;
begin
for n:=1 to 10 do
begin
aa:=TcImage.Create(Self);
aa.Parent:=form1;
aa.AutoSize:=True;
aa.Picture:=Image1.Picture;
aa.Top:=50*n;
aa.Left:=40*n;
aa.Visible:=True;
end;

end;

end.

不好意思，发错地方了.
还改不了了