怎样将查找的信息转化为execl输出呀?(50分)

  • 主题发起人 主题发起人 tnokiay
  • 开始时间 开始时间
T

tnokiay

Unregistered / Unconfirmed
GUEST, unregistred user!
怎样将查找出的信息转化为execl输出呀?
 
转贴
unit GesDb2Excell;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
db, ADOdb,OleServer, Excel2000,Variants;
type
TGesDb2Excell = class(TAdoDataset)
private
{ Private declarations }
FFileName:string;
FTitle:string;

protected
{ Protected declarations }
public
{ Public declarations }
constructor create(AOwer:TComponent);override;
//---------------New
procedure Dts2Excell();
//-------------------------------------------------------------------------------
published
property FileName:String read FFileName write FFileName;
property FileTitle:String read FTitle write FTitle;

{ Published declarations }

end;


procedure Register;

implementation


procedure Register;
begin
RegisterComponents('TongJin', [TGesDb2Excell]);
end;

constructor TGesDb2Excell.create(AOwer: TComponent);
begin
inherited;

end;

procedure TGesDb2Excell.Dts2Excell();
var
ExcelApplication1: TExcelApplication;
ExcelWorksheet1: TExcelWorksheet;
ExcelWorkbook1: TExcelWorkbook;
i, j: integer;
filename: string;
begin
filename := concat(extractfilepath(application.exename), FFileName, '.xls');
try
ExcelApplication1 := TExcelApplication.Create(Application);
ExcelWorksheet1 := TExcelWorksheet.Create(Application);
ExcelWorkbook1 := TExcelWorkbook.Create(Application);
ExcelApplication1.Connect;
except
Application.Messagebox('Excel 没有安装!', 'Hello', MB_ICONERROR + mb_Ok);
Abort;
end;
try
ExcelApplication1.Workbooks.Add(EmptyParam, 0);
ExcelWorkbook1.ConnectTo(ExcelApplication1.Workbooks[1]);
ExcelWorksheet1.ConnectTo(ExcelWorkbook1.Worksheets[1] as _worksheet);
self.First;
for j := 0 to Self.Fields.Count - 1 do
begin
ExcelWorksheet1.Cells.item[3, j + 1] := self.Fields[j].DisplayLabel;
ExcelWorksheet1.Cells.item[3, j + 1].font.size := '10';
end;
for i := 4 to Self.RecordCount + 3 do
begin
for j := 0 to self.Fields.Count - 1 do
begin
ExcelWorksheet1.Cells.item[i, j + 1] :=
Self.Fields[j].Asstring;
ExcelWorksheet1.Cells.item[i, j + 1].font.size := '10';
end;
Self.Next;
end;
ExcelWorksheet1.Columns.AutoFit;
ExcelWorksheet1.Cells.item[1, 2] := FileTitle;
ExcelWorksheet1.Cells.Item[1, 2].font.size :='14';
ExcelWorksheet1.SaveAs(filename);
Application.Messagebox(pchar('数据成功导出' + Ffilename), '确认',mb_Ok);
finally
ExcelApplication1.Disconnect;
ExcelApplication1.Quit;
ExcelApplication1.Free;
ExcelWorksheet1.Free;
ExcelWorkbook1.Free;
end;
End;

end.
 
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, Buttons, StdCtrls, ExtCtrls, DB, DBTables,Excel2000,OleServer,ComObj,
Grids, DBGrids, DBCtrls;


var
myexcel:variant;
workbook:olevariant;
worksheet:olevariant;
begin
try
myexcel:=createoleobject('excel.application');
myexcel.application.workbooks.add;
myexcel.caption:=q+'至'+w+'客情预订表';
myexcel.application.visible:=true;
workbook:=myexcel.application.workbooks[1];
worksheet:=workbook.worksheets.item[1];
except
showmessage('EXCEL不存在!');
end;
i:=1;
j:=4;
if q<>w then
worksheet.Cells(i,j):=q+'至'+w+'客情预订表'
else
worksheet.Cells(i,j):=q+'客情预订表';
i:=2; //EXECL表行号
n:=0;//query字段N序号
j:=1;//EXECL表列号
form23.Query1.First;
for n:=0 to form23.Query1.FieldCount -1 do
begin
worksheet.Cells(i,j):=form23.Query1.fields[n].DisplayLabel;
j:=j+1;
end;
i:=2; //EXECL表行号
n:=0;//query字段N序号
i:=2;//EXECL表行号

i:=2;
form23.query1.first;
while not form23.query1.eof do
begin
inc(i);
for j:=0 to form23.query1.fieldcount-1 do
worksheet.cells[i,j+1]:=form23.query1.fields[j].asstring;
form23.query1.next;
end;

 
procedure TForm1.SpeedButton5Click(Sender: TObject);
var Excel,WrkBook,WrkSheet:olevariant;
Begin
try
Excel := CreateOleObject('Excel.Application');
except
if Application.MessageBox('对不起,你的机器没有安装Microsoft Excel,是否继续导出?' + #13#13 + '导出后在您的机器上不能直接打开,必须安装Excel到机器上才能打开!', '注意', MB_OKCANCEL) = ID_no then
Exit;
end;
if SaveDialog1.Execute then Begin
FormMain.StatusBarMain.Panels[1].Text := '系统正在导出,请稍后......'; WrkBook:=Excel.WorkBooks.Add; Row := 1; SheetCount:=1;
while not Query1.Eof do
Begin
if Row=1 then for tmp := 0 to s_caption.Count - 1 do
//插入加入标题:
Excel.WorkSheets[SheetCount].Cells[Row,tmp+1].Value:=s_caption.Strings[tmp]; inc(Row); for tmp := 0 to Query1.FieldCount - 1 do
Begin
if Query1.Fields[tmp].FieldName='VIP_NO' then
Excel.WorkSheets[SheetCount].cells[Row, Tmp + 1].NumberFormatLocal:= '@' ;
Excel.WorkSheets[SheetCount].Cells[Row,Tmp+1].Value := Query1.Fields[tmp].AsString;
End;
if Row>50000 then
Begin
SheetCount:=SheetCount+1;
Row:=0;
if SheetCount>3 then
Begin
WrkSheet:=WrkBook.WorkSheets[WrkBook.WorkSheets.Count];
WrkBook.WorkSheets.Add(emptyparam,WrkSheet,1,$FFFFEFB9);
End;
End;
Query1.Next;
ProgressBar1.StepIt;
End;
Excel.Activeworkbook.saveas(SaveDialog1.FileName);
WrkBook.close;
Excel.quit ;
Excel:=unassigned ;
ShowMessage('系统已经导出,请到'+SaveDialog1.FileName+'里查看');
end;






 
利用dxdbgrid,它有savetoxcl的功能,而且可以从选择出来的内容里,再选择保存
 
谢谢你们的 帮助
 
接受答案了.
 
后退
顶部