怎么把sql数据库中的数据输出到excel中保存？

[china97]

delphi中的打印老是出问题，我想干脆借用excel来打印算了。
不过怎么把sql数据库中的数据输出到excel中呢？

[turbozzh]

给你源码：
TQuery的结果到入Excel
unit ExcelTest;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Buttons, ExtCtrls,db,DBTables, ComCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Query1: TQuery;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
procedure WriteDatasetToExcel(AQueryName: TQuery; AStrVar: String);
end;

var
Form1: TForm1;

implementation

uses Comobj;

{$R *.DFM}

{ TForm1 }

procedure TForm1.WriteDatasetToExcel(AQueryName: TQuery; AStrVar: String);
var
EclApp,WorkBook : Variant;
xlsFileName : String ;
I : Integer ;
column : Integer ;
Row : Integer ;
Fdate:TDateTime;
Year, Month, Day, Hour, Min, Sec, MSec: Word;
StrDate:String ;
StrDate1:String ;
Begin
Fdate:=now ;
DecodeDate(Fdate, Year, Month, Day);
DecodeTime(Fdate, Hour, Min, Sec, MSec);
StrDate:=formatdatetime('yyyy-mm-dd-hh-mm-ss',Fdate) ;
StrDate1:=formatdatetime('yyyy/mm/dd hh:mm:ss',Fdate) ;
If AStrVar='Excel文件测试' Then
Begin
xlsfilename :='Excel文件测试' ;
End ;

Try
Begin
EclApp := CreateOleObject('Excel.Application');
WorkBook:=CreateOleObject('Excel.Sheet');
End
Except
ShowMessage('您的计算机上没有 Microsoft Excel!');
Exit;
end;
try
workBook:=EclApp.workBooks.Add ;
row:=2;
EclApp.Workbooks.Item[1].Activate;
eclApp.Cells.font.colorindex:=5 ;
EclApp.Activesheet.Cells(1,1):=AStrVar ;
For I := 1 To AQueryName.FieldCount Do
EclApp.Activesheet.Cells(2,I):=AQueryName.Fields[I-1].FieldName ;
If Not AQueryName.Active Then AQueryName.Active := True ;
AQueryName.First ;
While Not(AQueryName.Eof) do
begin
column:=1;
for i:=1 to AQueryName.FieldCount do
begin
eclApp.Cells.Item[row+1,column]:=AQueryName.fields[i-1].AsString;
column:=column+1;
end;
AQueryName.Next;
row:=row+1;
End ;
WorkBook.saveas(xlsFileName);
WorkBook.close;
WorkBook:=eclApp.workBooks.Open(xlsFileName);
if MessageDlg('xlsFileName'+'对该文件是否保存?',
mtConfirmation,[mbYes, mbNo], 0) = mrYes then
WorkBook.save
Else
workBook.Saved := True;
WorkBook.Close;
eclApp.Quit;
eclApp:=Unassigned;
except
ShowMessage('Excel 文件保存失败');
WorkBook.close;
eclApp.Quit; {释放VARIANT变量}
eclApp:=Unassigned;
end;
ShowMessage('EXCEL 文件保存完毕') ;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
WriteDatasetToExcel(query1,'Excel文件测试');
end;

end.

[china97]

谢谢！谢谢！

[notopx]

在TExcelApplication 的Range 属性可以在 Excel 中加入数据，不过其他方面的控制得用 Idispatch 接口，这个我也想问。

[kuangning]

历史帖子中有这方面的资料
我有现成的控件，可以将数据集导入execel , word , html ,txt 等，有源代码
想要的同志联系我
QQ : 28602895
E_mail : [e-mail]

[china97]

to kuangning(郎之间,穷人):
能否把相关的资料和控件发给我？
　[e-mail]
拜托了！谢谢！

[Tense]

可以采用Olecontainer实现。

[xiaoyebing]

这是把DBGrid中数据导出到Execl文件的一个过程，你可以试试看。
当然，直接使用Excel OLE控件也可以的，不过我这里推荐一下F1Book(Delphi自带有)这个控件，还不错的，你可以去下载最新的F6Book：-）

procedure ExportExcel(const PathName: WideString; FileType: Smallint);
var
i,j:integer;
F1Book1:TF1Book;
begin
F1Book1 := TF1Book.Create(nil);
for i := 1 to dbgridCxjg.Columns.Count do
begin
F1Book1.TextRC[1,i] := dbgridCxjg.Columns.Items[i-1].Title.Caption;
end;
dm1.dsqCxjg.DataSet.First;
j := 1;
while not dm1.dsqCxjg.DataSet.Eof do
begin
j := j + 1;
for i := 1 to dbgridCxjg.Columns.Count do
begin
F1Book1.TextRC[j,i] := dm1.dsqCxjg.DataSet.Fields[i-1].AsString;
end;
dm1.dsqCxjg.DataSet.Next;
end;
F1Book1.Write(PathName,FileType);
F1Book1.Free;
end;

[ownyou]

我要 控件
[e-mail]
thanks

[MouseBrother]

我也要控件
[e-mail]
谢谢

[MouseBrother]

我也要控件
[e-mail]
谢谢

[cobi]

gz

[china97]

to xiaoyebing(Boolean):
f6book那里有下载？能说个大概的网址吗？
　当然，要是能给出url那就更好了，呵呵．谢谢了！！

[王集鹄]

Step1.把数据放到剪贴板中
'Value(1,1)'#8'Value(2,1)'#13#10
'Value(1,2)'#8'Value(2,2)'#13#10
'Value(1,3)'#8'Value(2,3)'#13#10
Step2.调用并显示Excel
Step3.模拟Ctrl+V

[韩小明]

我也要控件
[e-mail]

[yoryor]

利用BATCHMOVE应该可以。

[copy_paste]

用SQL语句可以全部搞写，我在help看到有。
它是针对Access,但是你改一个，可以变成Excel
http://www.csdn.net/expert/TopicView.asp?id=288983

[china97]

还有什么其它好办法吗？
看看我们程序员的想象力如何？呵呵

[china97]

谢谢!　谢谢！

[dqbilly]

请教xiaoyebing(Boolean)　
F1Book1.Write(PathName,FileType);
中的filetype都有哪些可选的值?
谢谢

[xiaoyebing]

呵呵，不好意思，好久没有上来了，没看到大家的留言
要控件的朋友啊，可惜太大了，我还是留个下载地址吧~~
太大了，不能给你mail过去。
名称:f1setup.exe
URL:http://www.pdriver.com/activex/f1setup.exe
大小: 8806KB
完成时间:Mon Jul 02 19:15:34 2001
引用页:http://www.pdriver.com/display.asp?key_id=1233&ai_down=1
注释:http://www.pdriver.com/activex/f1setup.exe

名称:fisetup.exe
URL:http://www.pdriver.com/activex/fisetup.exe
大小: 9885KB
完成时间:Mon Jul 02 19:16:06 2001
引用页:http://www.ocloud.com/download/search.php
注释:

pbstudy.top263.net/download/formula_one6.htm
202.102.2.140/userpage/startworld/softdown4.htm
www.soft21.com.cn/soft21/Shareware/Default.asp
www.coast.com.cn/download.htm
lmq.4y.com.cn/download.htm

s/n :tti.fpa5.06.00.0189390322