详细请教数据库导出execl表格。(50分)

  • 主题发起人 主题发起人 黑狗
  • 开始时间 开始时间

黑狗

Unregistered / Unconfirmed
GUEST, unregistred user!
有例子最好!
这个问题真是麻烦。!
 
adataset:TTable或TQuery;
selrows:TDBGrid的SelectedRows属性;
procedure WriteToExcel(adataset: TDataSet; selrows: TBookmarkList);
var oexcel: OleVariant;
i,j: integer;
begin
try
oexcel:=GetActiveOleObject('Excel.Application');
except
try
oexcel:=CreateOleObject('Excel.Application');
except
MessageDlg('无法启动EXCEL程序。'+#13+'请确定该程序已正确安装!',mtInformation,[mbOK],0);
exit;
end;
end;
oexcel.WorkBooks.Add;
with adataset do begin
for i:=1 to FieldCount do
oexcel.WorkSheets['Sheet1'].Cells[1,i].Value:=Fields[i-1].FieldName;
if selrows<>nil then begin
for j:=2 to selrows.Count+1 do begin
GotoBookmark(pointer(selrows.Items[j-2]));
for i:=1 to FieldCount do begin
Application.ProcessMessages;
oexcel.WorkSheets['Sheet1'].Cells[j,i].Value:=Fields[i-1].AsString;
end;
end;
end else begin
j:=2;
First;
while not eof do begin
for i:=1 to FieldCount do begin
Application.ProcessMessages;
oexcel.WorkSheets['Sheet1'].Cells[j,i].Value:=Fields[i-1].AsString;
end;
j:=j+1;
Next;
end;
end;
end;
oexcel.Visible:=true;
end;
 
我这里有又一个方法:
procedure Tfrom1.button1.click(sender:object);
var
myexcel:variant;
workbook:olevariant;
worksheet:olevariant;
i,j:integer;
begin
try
myexcel:=createoleobject('excel.application');
myexcel.application.wordbooks.add;
myexcel.caption:='将数据导入到EXCEL表中';
myexcel.application.visible:=true;
workbook:=myexcelobject1.application.workbooks[1];
wordsheet:=wordbook.wordsheets.item[1];
except
showmessage('EXCEL不存在!');
end;
i:=0;
table1.first;
while not table1.eof do
begin
inc(i);
for j:=0 to table1.fieldcount-1 do
wordsheet.cells[i,j+1]:=table1.fields[j].asstring;
table1.next;
end;
end;
有什么好的方法请与我联系gukehui@sohu.com.cn
 
用OLE的方法太慢,这方面的控件很多,还是看看他们这么做的吧.
 
以上两个例子在运行时都提示“未宣告的标识”,请问要加入什么单元?还是怎么回事?
如有code,最好。
mailto:
blackdog99@21cn.com
 
我用delphi5 office控件从数据库导入EXCEL表row>2500就死机,改用getoleobject就解决
 
黑狗
uses ComObj
 
从项目代码中直接粘过来请自行根据需要进行改动.不要忘了引用单元[8D]

procedure TFrmReport.BitBtn1Click(Sender: TObject);
var c,r,i,j : integer ;
app : Olevariant ;
TempFileName,ResultFileName : String ;
begin
try
app := CreateOLEObject('Excel.application') ;
except
Messagedlg('Excel没有正确安装!',mterror,[mbok],0);
exit ;
end ;
TempFileName := ReportTitle ;
app.Workbooks.add ;
app.Visible := false ;

DBGResult.DataSource.DataSet.First ;
c:=DBGResult.DataSource.DataSet.FieldCount ;
r:=DBGResult.DataSource.DataSet.RecordCount ;

for i:=0 to c-1 do
app.cells(1,1+i):= DBGResult.DataSource.DataSet.Fields.DisplayLabel ;
for j:=1 to r do
begin
for i:=0 to c-1 do
app.cells(j+1,1+i):= DBGResult.DataSource.DataSet.Fields.AsString ;

DBGResult.DataSource.DataSet.Next ;
end ;

ResultFileName := TempFileName ;
if ResultFileName='' then ResultFileName:='自动报表' ;
if FileExists(ExtractFilePath(Application.EXEName)+ResultFileName+'.xls') then
DeleteFile(ExtractFilePath(Application.EXEName)+ResultFileName+'.xls') ;

app.Activeworkbook.saveas(ExtractFilePath(Application.EXEName)+ResultFileName+'.xls') ;
app.Activeworkbook.close(false) ;
app.quit ;
app:=unassigned ;
end;
 
谢谢各位。问题已解决。以上三个方案我都进行了测试,根据wbo的提示加上了comobj单元
后,测试成功。以下是我对三位的测试报告:
wbo:代码详尽,但启动execl后,无窗口显示,仿若死机,不知为何。如果以web方式查看
将只有第一行数据。
ailun:代码最简单,但操作的是table,还有一堆错别字,嘻嘻。不过却能迅速导出数据。
狄克:代码通俗易懂,呵呵,我喜欢,而且针对的是dbgrid,呵呵,希望有机会继续请教。
分不是很多,如果下次再有需求,请各位大力协助,一定加分。嘻嘻。
以下是全部代码:
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, DBCtrls, Grids, DBGrids, DB, DBTables,ComObj, StdCtrls;

type
TForm1 = class(TForm)
DataSource1: TDataSource;
Table1: TTable;
DBGrid1: TDBGrid;
DBNavigator1: TDBNavigator;
Button1: TButton;
Button2: TButton;
Button3: TButton;
Button4: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
private
{ Private declarations }
public
procedure WriteToExcel(adataset: TDataSet; selrows: TBookmarkList);

{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
myexcel:variant;
workbook:olevariant;
worksheet:olevariant;
i,j:integer;
begin
try
myexcel:=createoleobject('excel.application');
myexcel.application.workbooks.add;
myexcel.caption:='将数据导入到EXCEL表中';
myexcel.application.visible:=true;
workbook:=myexcel.application.workbooks[1];
worksheet:=workbook.worksheets.item[1];
except
showmessage('EXCEL不存在!');
end;
i:=0;
table1.first;
while not table1.eof do
begin
inc(i);
for j:=0 to table1.fieldcount-1 do
worksheet.cells[i,j+1]:=table1.fields[j].asstring;
table1.next;
end;
end;


procedure TForm1.WriteToExcel(adataset: TDataSet; selrows: TBookmarkList);
var oexcel: OleVariant;
i,j: integer;
begin
try
oexcel:=GetActiveOleObject('Excel.Application');
except
try
oexcel:=CreateOleObject('Excel.Application');
except
MessageDlg('无法启动EXCEL程序。'+#13+'请确定该程序已正确安装!',mtInformation,[mbOK],0);
exit;
end;
end;
oexcel.WorkBooks.Add;
with adataset do begin
for i:=1 to FieldCount do
oexcel.WorkSheets['Sheet1'].Cells[1,i].Value:=Fields[i-1].FieldName;
if selrows<>nil then begin
for j:=2 to selrows.Count+1 do begin
GotoBookmark(pointer(selrows.Items[j-2]));
for i:=1 to FieldCount do begin
Application.ProcessMessages;
oexcel.WorkSheets['Sheet1'].Cells[j,i].Value:=Fields[i-1].AsString;
end;
end;
end else begin
j:=2;
First;
while not eof do begin
for i:=1 to FieldCount do begin
Application.ProcessMessages;
oexcel.WorkSheets['Sheet1'].Cells[j,i].Value:=Fields[i-1].AsString;
end;
j:=j+1;
Next;
end;
end;
end;
oexcel.Visible:=true;
end;


procedure TForm1.Button2Click(Sender: TObject);
begin
WriteToExcel(table1,dbgrid1.SelectedRows);
end;

procedure TForm1.Button3Click(Sender: TObject);
var c,r,i,j : integer ;
app : Olevariant ;
TempFileName,ResultFileName : String ;
begin
try
app := CreateOLEObject('Excel.application') ;
except
Messagedlg('Excel没有正确安装!',mterror,[mbok],0);
exit ;
end ;
TempFileName := 'test' ;
app.Workbooks.add ;
app.Visible := false ;

dbgrid1.DataSource.DataSet.First;
// DBGResult.DataSource.DataSet.First ;
c:=dbgrid1.DataSource.DataSet.FieldCount ;
r:=dbgrid1.DataSource.DataSet.RecordCount ;

for i:=0 to c-1 do
app.cells(1,1+i):= dbgrid1.DataSource.DataSet.Fields.DisplayLabel ;
for j:=1 to r do
begin
for i:=0 to c-1 do
app.cells(j+1,1+i):= dbgrid1.DataSource.DataSet.Fields.AsString ;

dbgrid1.DataSource.DataSet.Next ;
end ;

ResultFileName := TempFileName ;
if ResultFileName='' then ResultFileName:='自动报表' ;
if FileExists(ExtractFilePath(Application.EXEName)+ResultFileName+'.xls') then
DeleteFile(ExtractFilePath(Application.EXEName)+ResultFileName+'.xls') ;

app.Activeworkbook.saveas(ExtractFilePath(Application.EXEName)+ResultFileName+'.xls') ;
app.Activeworkbook.close(false) ;
app.quit ;
app:=unassigned ;
end;


procedure TForm1.Button4Click(Sender: TObject);
begin
table1.Filtered:=false;
table1.Filter:='空调名称='+QuotedStr('海尔空调');
table1.Filtered:=true;
end;

end.
 
黑狗:
> procedure TForm1.Button2Click(Sender: TObject);
> begin
> WriteToExcel(table1,dbgrid1.SelectedRows);
> end;
如果没有在dbgrid1中的某个记录上点击,应改为
WriteToExcel(table1,nil);
这样就不会只有一行了。
 
为何我按照上述方法,总提示“标记没有引用存储”,我的是 office2000, officexp(是否与此有关)
请高手指教
 
后退
顶部