一;
delphi 快速导出excel
uses ComObj,clipbrd;
function ToExcel(sfilename:string; ADOQuery:TADOQuery):boolean;
const
xlNormal=-4143;
var
y : integer;
tsList : TStringList;
s,filename :string;
aSheet :Variant;
excel :OleVariant;
savedialog :tsavedialog;
begin
Result := true;
try
excel:=CreateOleObject('Excel.Application');
excel.workbooks.add;
except
//screen.cursor:=crDefault;
showmessage('无法调用Excel!');
exit;
end;
savedialog:=tsavedialog.Create(nil);
savedialog.FileName:=sfilename; //存入文件
savedialog.Filter:='Excel文件(*.xls)|*.xls';
if savedialog.Execute then
begin
if FileExists(savedialog.FileName) then
try
if application.messagebox('该文件已经存在,要覆盖吗?','询问',mb_yesno+mb_iconquestion)=idyes then
DeleteFile(PChar(savedialog.FileName))
else
begin
Excel.Quit;
savedialog.free;
//screen.cursor:=crDefault;
Exit;
end;
except
Excel.Quit;
savedialog.free;
screen.cursor:=crDefault;
Exit;
end;
filename:=savedialog.FileName;
end;
savedialog.free;
if filename='' then
begin
result:=true;
Excel.Quit;
//screen.cursor:=crDefault;
exit;
end;
aSheet:=excel.Worksheets.Item[1];
tsList:=TStringList.Create;
//tsList.Add('查询结果'); //加入标题
s:=''; //加入字段名
for y := 0 to adoquery.fieldCount - 1 do
begin
s:=s+adoQuery.Fields.Fields[y].FieldName+#9 ;
Application.ProcessMessages;
end;
tsList.Add(s);
try
try
ADOQuery.First;
While Not ADOQuery.Eof do
begin
s:='';
for y:=0 to ADOQuery.FieldCount-1 do
begin
s:=s+ADOQuery.Fields[y].AsString+#9;
Application.ProcessMessages;
end;
tsList.Add(s);
ADOQuery.next;
end;
Clipboard.AsText:=tsList.Text;
except
result:=false;
end;
finally
tsList.Free;
end;
aSheet.Paste;
MessageBox(Application.Handle,'数据导出完毕!','系统提示',MB_ICONINFORMATION or MB_OK);
try
if copy(FileName,length(FileName)-3,4)<>'.xls' then
FileName:=FileName+'.xls';
Excel.ActiveWorkbook.SaveAs(FileName, xlNormal, '', '', False, False);
except
Excel.Quit;
screen.cursor:=crDefault;
exit;
end;
Excel.Visible := false; //true会自动打开已经保存的excel
Excel.Quit;
Excel := UnAssigned;
end;
调用:
ToExcel('D:\a.xsl',QueryToExcel);//路径可以自定义
-------------------------------------------------------------------------------------------------
*************************************************************************************************
二;
delphi如何导出EXCEL,代码。非第3方控件
首先在Uses处加上ComObj
procedure TForm1.Button1Click(Sender: TObject);
var h,k:integer;
Excelid: OleVariant;
s: string;
begin
try
Excelid := CreateOLEObject('Excel.Application');
except
Application.MessageBox('Excel没有安装!', '提示信息', MB_OK+MB_ICONASTERISK+MB_DEFBUTTON1+MB_APPLMODAL);
Exit;
end;
try
ADOQuery1.Close;
ADOQuery1.SQL.Clear;
ADOQuery1.SQL.Add('select * from jj_department');
ADOQuery1.Open;
k:=ADOQuery1.RecordCount;
Excelid.Visible := True;
Excelid.WorkBooks.Add;
Excelid.worksheets[1].range['A1:c1'].Merge(True);
Excelid.WorkSheets[1].Cells[1,1].Value :='部门编码表' ;
Excelid.worksheets[1].Range['a1:a1'].HorizontalAlignment := $FFFFEFF4;
Excelid.worksheets[1].Range['a1:a1'].VerticalAlignment := $FFFFEFF4;
Excelid.WorkSheets[1].Cells[2,1].Value := '组别编号';
Excelid.WorkSheets[1].Cells[2,2].Value := '公司编号';
Excelid.WorkSheets[1].Cells[2,3].Value := '组别名称';
Excelid.worksheets[1].Range['A1:c1'].Font.Name := '宋体';
Excelid.worksheets[1].Range['A1:c1'].Font.Size := 9;
Excelid.worksheets[1].range['A1:c2'].font.bold:=true;
Excelid.worksheets[1].Range['A2:c2'].Font.Size := 9;
Excelid.worksheets[1].Range['A2:c2'].HorizontalAlignment := $FFFFEFF4;
Excelid.worksheets[1].Range['A2:c2'].VerticalAlignment := $FFFFEFF4;
h:=3;
ADOQuery1.First;
while not ADOQuery1.Eof do
begin Excelid.WorkSheets[1].Cells[h,1].Value := Adoquery1.FieldByName('Fdept_id').AsString;
Excelid.WorkSheets[1].Cells[h,2].Value := Adoquery1.FieldByName('Ffdept_id').AsString;
Excelid.WorkSheets[1].Cells[h,3].Value := Adoquery1.FieldByName('Fdept_name').AsString;
Inc(h);
Adoquery1.Next;
end;
s := 'A2:f'+ IntToStr(k+2);
Excelid.worksheets[1].Range[s].Font.Name := '宋体';
Excelid.worksheets[1].Range[s].Font.size := 9;
Excelid.worksheets[1].Range[s].Borders.LineStyle := 1;
Excelid.Quit;
except
Application.MessageBox('导入数据出错!请检查文件的格式是否正确!', '提示信息', MB_OK+MB_ICONASTERISK+MB_DEFBUTTON1+MB_APPLMODAL);
end;
MessageBox(GetActiveWindow(), 'EXCEL数据导出成功!', '提示信息', MB_OK +MB_ICONWARNING);
end;
-----------------------------------------------------------------------------------------------------------------------------------------------
****************************************************************************************************************************************
三;
delphi导出EXCEL
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, Mask, ComCtrls, StdCtrls, Buttons, Grids, ValEdit, IdBaseComponent,
CheckLst, excel97, ExcelXP, OleServer, ComObj, excel2000, mmsystem, ShellAPI,
ADODB, DB, DBGrids, clipbrd;
Var
FExcel:OleVariant; //excel应用程序
FWorkBook :OleVariant; //工作表
Temsheet:OleVariant; //工作薄
FPicture:OleVariant;//图片
tmpstr:String;
range:variant;//范围
i,j,TemInt:integer;
TemFileName:String;
begin
SaveDialog1.Filter:='.xls';
if SaveDialog1.Execute then
begin
TemFileName:=SaveDialog1.FileName+'.xls';
Screen.Cursor:=CrHourGlass;
TemInt:=0;
FExcel:= CreateoleObject('excel.Application');
FWorkBook:=FExcel.WorkBooks.Add(-4167); //新的工作表
Temsheet:=FWorkBook.Worksheets.Add;
Temsheet.Name:='利润统计';
Temsheet.Select;
Temsheet.Columns[1].ColumnWidth:=4;//设置列宽度
Temsheet.Columns[2].ColumnWidth:=10;
Temsheet.Columns[3].ColumnWidth:=16;
Temsheet.Columns[4].ColumnWidth:=10;
Temsheet.Columns[5].ColumnWidth:=10;
Temsheet.Columns[6].ColumnWidth:=10;
Temsheet.Columns[7].ColumnWidth:=10;
Temsheet.Columns[8].ColumnWidth:=10;
Temsheet.Columns[9].ColumnWidth:=20;
Temsheet.Columns[10].ColumnWidth:=15;
range:=Temsheet.Range[Temsheet.cells[1,1],Temsheet.cells[5,2]];//选定表格
range.select;
range.merge; //合并单元格
tmpstr:=ExtractFilePath(ParamStr(0))+'tem.jpg'; //添加图片
FPicture:=Temsheet.Pictures.Insert(tmpstr);
FPicture.Left:=20;
FPicture.Top:=5;
FPicture.width:=50;
FPicture.height:=50;
FPicture:=null;
range:=Temsheet.Range[Temsheet.cells[2,3],Temsheet.cells[3,4]];//选定表格
range.select;
range.merge;
Range.Characters.Font.FontStyle :='加粗';
Temsheet.Cells[2,3].HorizontalAlignment:=-4108; //字居中
Temsheet.Cells[2,3]:=ComSName;
range:=Temsheet.Range[Temsheet.cells[4,3],Temsheet.cells[4,4]];//选定表格
range.select;
range.merge;
Temsheet.Cells[4,3].HorizontalAlignment:=-4108; //字居中
Temsheet.Cells[4,3]:=ComEName;
range:=Temsheet.Range[Temsheet.cells[2,5],Temsheet.cells[2,6]];//选定表格
range.select;
range.merge;
Temsheet.Cells[2,5].HorizontalAlignment:=-4108; //字居中
Temsheet.Cells[2,5]:=ComName;
Temsheet.Cells[3,5]:='联系人:';
Temsheet.Cells[4,5]:='电话:';
Temsheet.Cells[4,6]:=ComPhone;
Temsheet.Cells[5,5]:='传真:';
Temsheet.Cells[5,6]:=ComFax;
range:=Temsheet.Range[Temsheet.cells[6,1],Temsheet.cells[6,10]];//选定表格
range.select;
range.merge;
range:=Temsheet.Range[Temsheet.cells[7,1],Temsheet.cells[7,2]];//选定表格
range.select;
range.merge;
Range.Characters.Font.FontStyle :='加粗';
Temsheet.Cells[7,1]:='入库信息:';
range:=Temsheet.Range[Temsheet.cells[7,3],Temsheet.cells[7,10]];//选定表格
range.select;
range.merge;
Temsheet.Cells[8,1]:='序号';
Temsheet.Cells[8,1].HorizontalAlignment:=-4108; //字居中
Temsheet.Cells[8,1].Interior.Color:=clGray; //单元格背景色
range:=Temsheet.Range[Temsheet.cells[8,1],Temsheet.cells[8,1]];//选定表格
range.borders.linestyle:=1;//华线
for i:=0 to DBGrid1.Columns.Count - 1 do
begin
Temsheet.Cells[8,i+2]:=DBGrid1.Columns[i].Title.Caption;
Temsheet.Cells[8,i+2].HorizontalAlignment:=-4108; //字居中
Temsheet.Cells[8,i+2].Interior.Color:=clGray; //单元格背景色
range:=Temsheet.Range[Temsheet.cells[8,i+2],Temsheet.cells[8,i+2]];//选定表格
range.borders.linestyle:=1;//华线
end;
//////////////////////////////////////////////
j:=0;
DBGrid1.DataSource.DataSet.First;
while not DBGrid1.DataSource.DataSet.Eof do
begin
Temsheet.Cells[9+j,1].Value:=j+1;
Temsheet.Cells[9+j,1].HorizontalAlignment:=-4108; //字居中
range:=Temsheet.Range[Temsheet.cells[9+j,1],Temsheet.cells[9+j,1]];//选定表格
range.borders.linestyle:=1;//华线
for i:=0 to DBGrid1.Columns.Count - 1 do
begin
Temsheet.Cells[9+j,i+2].Value:=DBGrid1.Fields[i].AsString;
range:=Temsheet.Range[Temsheet.cells[9+j,i+2],Temsheet.cells[9+j,i+2]];//选定表格
range.borders.linestyle:=1;//华线
end;
DBGrid1.DataSource.DataSet.Next;
j:=j+1;
end;
TemInt:=9+ DBGrid1.DataSource.DataSet.RecordCount;
range:=Temsheet.Range[Temsheet.cells[TemInt,1],Temsheet.cells[TemInt,10]];//选定表格
range.select;
range.merge;
TemInt:=TemInt+1;
range:=Temsheet.Range[Temsheet.cells[TemInt,1],Temsheet.cells[TemInt,2]];//选定表格
range.select;
range.merge;
Range.Characters.Font.FontStyle :='加粗';
Temsheet.Cells[TemInt,1]:='出库信息:';
range:=Temsheet.Range[Temsheet.cells[TemInt,3],Temsheet.cells[TemInt,10]];//选定表格
range.select;
range.merge;
TemInt:=TemInt+1;
Temsheet.Cells[TemInt,1]:='序号';
Temsheet.Cells[TemInt,1].HorizontalAlignment:=-4108; //字居中
Temsheet.Cells[TemInt,1].Interior.Color:=clGray; //单元格背景色
range:=Temsheet.Range[Temsheet.cells[TemInt,1],Temsheet.cells[TemInt,1]];//选定表格
range.borders.linestyle:=1;//华线
for i:=0 to DBGrid2.Columns.Count - 1 do
begin
Temsheet.Cells[TemInt,i+2]:=DBGrid2.Columns[i].Title.Caption;
Temsheet.Cells[TemInt,i+2].HorizontalAlignment:=-4108; //字居中
Temsheet.Cells[TemInt,i+2].Interior.Color:=clGray; //单元格背景色
range:=Temsheet.Range[Temsheet.cells[TemInt,i+2],Temsheet.cells[TemInt,i+2]];//选定表格
range.borders.linestyle:=1;//华线
end;
TemInt:=TemInt+1;
//////////////////////////////////////////////
j:=0;
DBGrid2.DataSource.DataSet.First;
while not DBGrid2.DataSource.DataSet.Eof do
begin
Temsheet.Cells[TemInt+j,1].Value:=j+1;
Temsheet.Cells[TemInt+j,1].HorizontalAlignment:=-4108; //字居中
range:=Temsheet.Range[Temsheet.cells[TemInt+j,1],Temsheet.cells[TemInt+j,1]];//选定表格
range.borders.linestyle:=1;//华线
for i:=0 to DBGrid2.Columns.Count - 1 do
begin
Temsheet.Cells[TemInt+j,i+2].Value:=DBGrid2.Fields[i].AsString;
range:=Temsheet.Range[Temsheet.cells[TemInt+j,i+2],Temsheet.cells[TemInt+j,i+2]];//选定表格
range.borders.linestyle:=1;//华线
end;
DBGrid2.DataSource.DataSet.Next;
j:=j+1;
end;
TemInt:=TemInt+ DBGrid2.DataSource.DataSet.RecordCount;
TemInt:=TemInt+1;
range:=Temsheet.Range[Temsheet.cells[TemInt,1],Temsheet.cells[TemInt,10]];//选定表格
range.select;
range.merge;
TemInt:=TemInt+1;
range:=Temsheet.Range[Temsheet.cells[TemInt,1],Temsheet.cells[TemInt,2]];//选定表格
range.select;
range.merge;
Range.Characters.Font.FontStyle :='加粗';
Temsheet.Cells[TemInt,1]:='入库总额:';
Temsheet.Cells[TemInt,3]:=Trim(Edit1.Text);
range:=Temsheet.Range[Temsheet.cells[TemInt,4],Temsheet.cells[TemInt,10]];//选定表格
range.select;
range.merge;
TemInt:=TemInt+1;
range:=Temsheet.Range[Temsheet.cells[TemInt,1],Temsheet.cells[TemInt,2]];//选定表格
range.select;
range.merge;
Range.Characters.Font.FontStyle :='加粗';
Temsheet.Cells[TemInt,1]:='出库总额:';
Temsheet.Cells[TemInt,3]:=Trim(Edit2.Text);
range:=Temsheet.Range[Temsheet.cells[TemInt,4],Temsheet.cells[TemInt,10]];//选定表格
range.select;
range.merge;
TemInt:=TemInt+1;
range:=Temsheet.Range[Temsheet.cells[TemInt,1],Temsheet.cells[TemInt,2]];//选定表格
range.select;
range.merge;
Range.Characters.Font.FontStyle :='加粗';
Temsheet.Cells[TemInt,1]:='总利润:';
Temsheet.Cells[TemInt,3]:=Trim(Edit3.Text);
range:=Temsheet.Range[Temsheet.cells[TemInt,4],Temsheet.cells[TemInt,10]];//选定表格
range.select;
range.merge;
range:=Temsheet.Range[Temsheet.cells[7,1],Temsheet.cells[TemInt,10]];//选定表格
range.borders.linestyle:=1;//华线
Application.ProcessMessages;
Screen.Cursor:=CrDefault;
FExcel.WorkBooks[1].saveas(TemFileName);//保存文件
FExcel.workbooks[1].close; //关闭工作表
Application.ProcessMessages;
MessageBox(Handle,'导出成功','提示',MB_OK);
//FExcel.visible:=true;
FExcel.quit; //关闭Excel
FExcel := unassigned;
shellexecute(0,'open',PChar(ExtractFileName(TemFileName)),nil,PChar(ExtractFilePath(TemFileName)),SW_Show);
end;
end;
--------------------------------------------------------------------------------------------------------------------
********************************************************************************************************************
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, Mask, ComCtrls, StdCtrls, Buttons, Grids, ValEdit, IdBaseComponent,
CheckLst, excel97, ExcelXP, OleServer, comobj, excel2000, mmsystem,
ADODB, DB, DBGrids, clipbrd;
四;
procedure TFIND_FM.Button1Click(Sender: TObject);
var
i,j : integer;
reportname, wpath : string;
ExApp1 : TExcelApplication;
ExWrbk1 : TExcelWorkbook;
ExWrst1 : TExcelWorksheet;
begin
if Main_FM.ADOQuery_TEMP.IsEmpty then
begin
Showmessage('沒有可導出的資料!');
Exit;
end
else
begin
Main_FM.SaveDialog1.FileName := 'qcreport';
if Main_FM.savedialog1.Execute then
begin
//savedialog1.FileName := formatdatetime('YYYYMMDDHHMMSS',now())+'md_orderqc_list.xls';
reportname := formatdatetime('YYYYMMDDHHMMSS',now())+ExtractFileName(Main_FM.savedialog1.FileName);
//reportname := formatdatetime('YYYYMMDDHHMMSS',now())+'';
wpath := ExtractFilePath(Main_FM.savedialog1.FileName);
//showmessage(wpath);
try
ExApp1 := TExcelApplication.Create(application);
ExWrbk1 := TExcelWorkbook.Create(application);
ExWrst1 := TExcelWorksheet.Create(application);
ExApp1.Connect;
except
Showmessage('電腦沒裝Excel!無法導出!');
Abort;
end;
try
try
ExApp1.Workbooks.Add(EmptyParam,0);
ExWrbk1.ConnectTo(ExApp1.Workbooks[1]);
ExWrst1.ConnectTo(ExWrbk1.Worksheets[1] as _worksheet);
Main_FM.ADOQuery_TEMP.First;
for j := 0 to Main_FM.ADOQuery_TEMP.FieldCount-1 do
begin
ExWrst1.Cells.Item[1,j+1] := Main_FM.ADOQuery_TEMP.Fields[j].DisplayName;
//
end;
for i := 2 to Main_FM.ADOQuery_TEMP.RecordCount+1 do
begin
for j := 0 to Main_FM.ADOQuery_TEMP.FieldCount-1 do
begin
ExWrst1.Cells.Item[i,j+1] := Main_FM.ADOQuery_TEMP.Fields[j].Value;
end;
Main_FM.ADOQuery_TEMP.Next;
end;
ExWrst1.SaveAs(wpath+reportname);
//ExWrst.SaveAs(formatdatetime('YYYYMMDDHHMMSS',now())+reportname);;
Showmessage('數據已成功導出!');
except
Showmessage('導出失敗!');
abort;
end;
finally
ExApp1.Disconnect;
ExApp1.Quit;
ExApp1.Free;
ExWrbk1.Free;
ExWrst1.Free;
end;
end;
end;
end;
--------------------------------------------------------------------------------------------------
**************************************************************************************************
delphi导出数据至Excel的三种方法及比较
闲来无事,跑到网上搜集了几种导出DataSet至Excel的几种方法。另外使用GetTickcount函数计算时差,以便比较。(本来使用Timer控件,但是Timer不适合做高精度时间计算)
使用TADOConnect,TADOQuery查询数据。
方法五:
使用TADOQuery + Varaint方法,循环遍历数据集中数据,直接插入到Excel的WookBook单元。这是初学者最易懂和易接受的方法。
在下面代码中没有仔细注意语法(比如没有使用try..finally结构体),如果需要使用,请注意:
//使用ADO循环方式保存
procedure TForm1.btn_WhileClick(Sender: TObject);
var
Eclapp:variant;
n:integer;
filename: string;
t1,t2: Int64;
begin
Eclapp := CreateOleObject('Excel.Application');
Eclapp.WorkBooks.Add;
Eclapp.Visible:= False;
filename :='d:\数据1.xls';
lbl2.Caption := '0';
if FileExists(fileName) then
DeleteFile(fileName);
t1:= GetTickCount;
qry1.DisableControls;
qry1.First;
n:=2;
while not qry1.Eof do
begin
eclapp.cells[n,1] := qry1.Fields[0].AsString;
eclapp.cells[n,2] := qry1.Fields[1].AsString;
eclapp.cells[n,3] := qry1.Fields[2].AsString;
eclapp.cells[n,4] := qry1.Fields[3].AsString;
//为了简单,只添加了4个栏位
inc(n);
qry1.Next;
application.ProcessMessages;
end;
qry1.EnableControls;
t2:= GetTickCount;
eclapp.visible := false;
eclapp.Workbooks[1].SaveAs(filename);
Eclapp.Quit;
Eclapp:= Unassigned;
lbl2.Caption := IntToStr(t2 - t1);
end;
---------------------------------------------------------------------------------------------------------
*********************************************************************************************************
方法六:使用OLE方法导入。
先讲TDateSet中的数据保存为二维OLEVariant数组中,再保存到Excel Sheet中 ///使用OLE方式保存procedure TForm1.btn_OleVariantClick(Sender: TObject);
var
fileName: string;
xlApp, Sheet: OleVariant;
rowCount, Colcount, index: Integer;
t1,t2: Int64;
function RefToCell(RowID, ColID: Integer): string;
var
ACount, APos: Integer;
begin
ACount := ColID div 26;
APos := ColID mod 26;
if APos = 0 then
begin
ACount := ACount - 1;
APos := 26;
end;
if ACount = 0 then
Result := Chr(Ord('A') + ColID - 1) + IntToStr(RowID);
if ACount = 1 then
Result := 'A' + Chr(Ord('A') + APos - 1) + IntToStr(RowID);
if ACount > 1 then
Result := Chr(Ord('A') + ACount - 1) + Chr(Ord('A') + APos - 1) + IntToStr(RowID);
end;
function getData(ds: TDataSet): OleVariant;
var
Data: OLEVariant;
i,j : Integer;
begin
rowCount := ds.RecordCount;
colCount := ds.FieldCount;
Data := VarArrayCreate([1, rowCount + 1, 1, colCount], varVariant); //1,rowCount 表示第一维数组的上下标,1,colCount表示第二维数组的上下标
i := 1;
for j := 0 to colCount - 1 do
begin
if not ds.Fields[j].Visible then
continue;
Data[i,j + 1] := ds.Fields[j].DisplayLabel;
end;
Inc(i);
ds.DisableControls;
try
ds.First;
while not ds.Eof do
begin
for j := 0 to colCount - 1 do
begin
Data[i,j + 1] := ds.Fields[j].AsString;
end;
Inc(i);
ds.Next;
Application.ProcessMessages;
end;
finally
ds.EnableControls;
end;
result := Data;
end;
begin
fileName := 'd:\数据.xls';
lbl1.Caption := '0';
t1:= GetTickCount;//开始计时
if FileExists(fileName) then
DeleteFile(fileName);
xlApp := CreateOleObject('Excel.Application');
try
XLApp.Visible := False;
XLApp.DisplayAlerts := False;
XLApp.Workbooks.Add;
// 删除多余的 worksheet
for index := XLApp.SheetsInNewWorkbook downto 2 do
begin
XLApp.Workbooks[1].Worksheets[index].Delete;
end;
Sheet := XLApp.Workbooks[1].Worksheets[1];
index := 1;
if index <> 0 then
Sheet := XLApp.Workbooks[1].Worksheets.Add;
Sheet.Name := qry1.Name;
//Sheet.Columns.NumberFormatLocal := '@'; //设置单元格式为文本
Sheet.Range[RefToCell(1, 1), RefToCell(rowCount + 1, colCount)].Value := getData(qry1);
XLApp.Workbooks[1].SaveAs(fileName);
finally
if not VarIsEmpty(XLApp) then
begin
XLApp.Quit;
XLAPP := Unassigned;
Sheet := Unassigned;
application.ProcessMessages;
t2:= GetTickCount;
lbl1.Caption := IntToStr( t2 - t1);
end;
end;
end;
-------------------------------------------------------------------------------------------------------
*******************************************************************************************************
方法七:现在最流行的文件流方法
.....
var
Form1: TForm1;
arXlsBegin: array[0..5] of Word = ($809, 8, 0, $10, 0, 0);
arXlsEnd: array[0..1] of Word = ($0A, 00);
arXlsString: array[0..5] of Word = ($204, 0, 0, 0, 0, 0);
arXlsNumber: array[0..4] of Word = ($203, 14, 0, 0, 0);
arXlsInteger: array[0..4] of Word = ($27E, 10, 0, 0, 0);
arXlsBlank: array[0..4] of Word = ($201, 6, 0, 0, $17);
Procedure ExportExcelFile(FileName: string; bWriteTitle: Boolean; aDataSet: TDataSet);
implementation
{$R *.dfm}
//使用文件流
procedure incColRow; //增加行列号
begin
if Col = ADataSet.FieldCount - 1 then
begin
Inc(Row);
Col :=0;
end
else
Inc(Col);
end;
procedure WriteStringCell(AValue: string);//写字符串数据
var
L: Word;
begin
L := Length(AValue);
arXlsString[1] := 8 + L;
arXlsString[2] := Row;
arXlsString[3] := Col;
arXlsString[5] := L;
aFileStream.WriteBuffer(arXlsString, SizeOf (arXlsString));
aFileStream.WriteBuffer(Pointer(AValue)^, L);
IncColRow;
end;
procedure WriteIntegerCell(AValue: integer);//写整数
var
V: Integer;
begin
arXlsInteger[2] := Row;
arXlsInteger[3] := Col;
aFileStream.WriteBuffer(arXlsInteger, SizeOf(arXlsInteger));
V := (AValue shl 2) or 2;
aFileStream.WriteBuffer(V, 4);
IncColRow;
end;
procedure WriteFloatCell(AValue: double );//写浮点数
begin
arXlsNumber[2] := Row;
arXlsNumber[3] := Col;
aFileStream.WriteBuffer(arXlsNumber, SizeOf(arXlsNumber));
aFileStream.WriteBuffer(AValue, 8);
IncColRow;
end;
Procedure ExportExcelFile(FileName: string; bWriteTitle: Boolean; aDataSet: TDataSet);
var
i,j: integer;
Col , row: word;
ABookMark: TBookMark;
aFileStream: TFileStream;
//......
//......
begin
if FileExists(FileName) then DeleteFile(FileName); //文件存在,先删除
aFileStream := TFileStream.Create(FileName, fmCreate);
Try //写文件头
aFileStream.WriteBuffer(arXlsBegin, SizeOf(arXlsBegin)); //写列头
Col := 0; Row := 0;
if bWriteTitle then
begin
for i := 0 to aDataSet.FieldCount - 1 do
WriteStringCell(aDataSet.Fields[i].FieldName);
end; //写数据集中的数据
aDataSet.DisableControls;
//ABookMark := aDataSet.GetBookmark;
aDataSet.First ;
while not aDataSet.Eof do
begin
for i := 0 to aDataSet.FieldCount - 1 do
case ADataSet.Fields[i].DataType of
ftSmallint, ftInteger, ftWord, ftAutoInc, ftBytes:
WriteIntegerCell(aDataSet.Fields[i].AsInteger);
ftFloat, ftCurrency, ftBCD:
WriteFloatCell(aDataSet.Fields[i].AsFloat)
else
WriteStringCell(aDataSet.Fields[i].AsString);
end;
aDataSet.Next;
Application.ProcessMessages;
end;
//写文件尾
AFileStream.WriteBuffer(arXlsEnd, SizeOf(arXlsEnd));
//if ADataSet.BookmarkValid(ABookMark) then aDataSet.GotoBookmark(ABookMark);
Finally
AFileStream.Free;
ADataSet.EnableControls;
end;
end;
//调用:
procedure TForm1.btn_FileStreamClick(Sender: TObject);
var
t1,t2: Int64;
begin
lbl3.Caption := '0';
t1:= GetTickCount;
ExportExcelFile('d:\数据2.xls',true,qry1);
t2:= GetTickCount;
lbl3.Caption:= IntToStr(t2 - t1);
end;
- Delphi 导出数据至Excel的7种方法
一; delphi 快速导出excel uses ComObj,clipbrd; function ToExcel(sfilename:string; ADOQuery:TADOQuery):bool ...
- 【转】asp.net导出数据到Excel的三种方法
来源:http://www.cnblogs.com/lishengpeng1982/archive/2008/04/03/1135490.html 原文出处:http://blog.csdn.net/ ...
- 对.NET中导出数据到EXCEL的几种方法探讨
最近在做一个报表系统的时候,需要把DATASET中的数据导到EXCEL当中,于是在网上找了一遍,发现了好几种方法,本来以为应该差不多,但后来经过一一试用后,发现在性能上真的差别很大,现在就介绍一下,同 ...
- 浅谈控件(组件)制作方法一(附带一delphi导出数据到Excel的组件实例)(原创)
来自:http://blog.csdn.net/zhdwjie/article/details/1490741 -------------------------------------------- ...
- Java导出数据为EXCEL的两种方式JXL和POI
JXL和POI导出数据方式的比较 POI支持excel2003和2007,而jxl只支持excel2003. 下面为测试代码: public class TestCondition { /** * 生 ...
- mysql导出数据到excel的两种方式
使用第一种方式如果数据中有换行符的话会自动换行,但使用第二种方式就不会出现这种效果了.两种方式自己选择哈 1:select * from into outfile 'c:/Users/a.xls' t ...
- delphi 导出到excel的7种方法
本文来自 爱好者8888 的CSDN 博客 ,全文地址请点击:https://blog.csdn.net/kpc2000/article/details/17066823?utm_source=cop ...
- Dynamics CRM导出数据到Excel
原创地址:http://www.cnblogs.com/jfzhu/p/4276212.html 转载请注明出处 Pivot Table是微软BI的一个重要工具,所以这里讲一下Dynamics CRM ...
- python 导出数据到excel 中,一个好用的导出数据到excel模块,XlsxWriter
最近公司有项目需要导出数据到excel,首先想到了,tablib,xlwt,xlrd,xlwings,win32com[还可以操作word],openpyxl,等模块但是 实际操作中tablib 写入 ...
随机推荐
- 学习CSS布局 - 没有布局
如果你只想把所有内容都塞进一栏里,那么不用设置任何布局也是OK的. 然而,如果用户把浏览器窗口调整的很大,这时阅读网页会非常难受: 读完每一行之后,你的视觉焦点要从右到左移动一大段距离. 试着调整下浏 ...
- Oracle ORA-01940: 无法删除当前连接的用户
当我们要删除一个oracle的用户时,如果有其他人连接到数据库则会报以下错误: ORA-01940: 无法删除当前连接的用户 处理办法就是:将连接到当前用户的session给kill掉. 处理步骤如下 ...
- [03] mapper.xml的基本元素概述
1.select 我们基于这个持久层接口 GirlDao: public interface GirlDao { List<Girl> findByAge(int age); Girl f ...
- BZOJ3676 APIO2014 回文串 Manacher、SA
传送门 首先一个结论:串\(S\)中本质不同的回文串个数最多有\(|S|\)个 证明考虑以点\(i\)结尾的所有回文串,假设为\(S[l_1,i],S[l_2,i],...,S[l_k,i]\),其中 ...
- angularjs呼叫Web API
今早有分享一篇<创建Web API并使用>http://www.cnblogs.com/insus/p/7771428.html 接下来,我再分享一篇,怎样在angularjs去呼叫Web ...
- EZ 2018 05 20 NOIP2018 模拟赛(十五)
这次的比赛充满着玄学的气息,玄学链接 首先讲一下为什么没有第十四场 其实今天早上9点时看到题目就叫了:原题! 没错,整套试卷都做过,我还写了题解 然后老叶就说换一套,但如果仅仅是这样就没什么 但等13 ...
- vue 中使用 async/await 将 axios 异步请求同步化处理
1. axios 常规用法: export default { name: 'Historys', data() { return { totalData: 0, tableData: [] } }, ...
- 学习ML.NET(3): 导入数据集
机器学习算法需要作用于数据,用来训练算法模型.数据集通常是以纯文本文件存储的表格数据,文件的每一行是一条数据记录,每条记录由多列组成,列之间用分隔符(一般是逗号,)分开,例如前面用到过的鸢尾花数据集. ...
- Roslyn入门(一)-C#语法分析
演示环境 Visual Studio 2017 .NET Compiler Platform SDK 简介 今天,Visual Basic和C#编译器是黑盒子:输入文本然后输出字节,编译管道的中间阶段 ...
- ABP+AdminLTE+Bootstrap Table权限管理系统第六节--abp控制器扩展及json封装以及6种处理时间格式化的方法
返回总目录:ABP+AdminLTE+Bootstrap Table权限管理系统一期 一,控制器AbpController 说完了Swagger ui 我们再来说一下abp对控制器的处理和json的封 ...