谢谢各位。问题已解决。以上三个方案我都进行了测试,根据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
levariant;
worksheet
levariant;
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.