如何将DataSet的内容保存为Excel(*.xls)文件?(100分)

  • 主题发起人 主题发起人 cnetwei
  • 开始时间 开始时间
C

cnetwei

Unregistered / Unconfirmed
GUEST, unregistred user!
如何将DataSet的内容保存为Excel(*.xls)文件?
 
找个EhLib吧,还能导出为Html!
 
用ole控件
 
你可以用OLE方法新建一个EXCEL表,再用循环将Dataset的内容逐条导入到EXCEL中去。
下面我只给出了用OLE方法操纵EXCEL的一个例子,里面已经说明了如何新建一个EXCEL表
或打开一个已存在的EXCEL表的方法。注意要uses comobj。


var ExcelApp:Variant;
begin
ExcelApp:=CreateOleObject('Excel.Application');
//ExcelApp.visible:=true;
ExcelApp.Caption:='应用程序调用 Microsoft Excel';
ExcelApp.WorkBooks.Add; //新增工作簿
//ExcelApp.workBooks.Open('C:/My Documents/Ca09lin1.xls'); //打开已存在工作簿
ExcelApp.Worksheets[2].activate; //打开第2个工作表
//ExcelApp.WorkSheets['第四章'].activate; //打开名为第四章的工作表
ExcelApp.Cells[1,4].Value:='第一行第四列';
ExcelApp.Cells[1,5].Value:='第一行第五列';
ExcelApp.ActiveSheet.Columns[4].ColumnWidth:=15;
ExcelApp.ActiveSheet.Rows[1].RowHeight:=15;
//ExcelApp.WorkSheets[1].Rows[8].PageBreak:=1; //设置分页符,但似无效
//Excelapp.ActiveSheet.Rows[8].PageBreak:=1; //同上
ExcelApp.ActiveSheet.Range['B3:D4'].Borders[2].Weight:=3;
ExcelApp.ActiveSheet.Range['B3:D4'].Borders[1].Weight:=3;
ExcelApp.ActiveSheet.Range['B3:D4'].Borders[3].Weight:=3;
ExcelApp.ActiveSheet.Range['B3:D4'].Borders[4].Weight:=3;
//ExcelApp.ActiveSheet.Range['B3:D4'].Borders[5].Weight:=3; //会直接在范围内的各Cell内加上斜杠|
//ExcelApp.ActiveSheet.Range['B3:D4'].Borders[6].Weight:=3; //与上句类似
//Bordrs:1-左 2-右 3-顶 4-底 5-斜( / ) 6-斜( / )
ExcelApp.Cells[3,2].Value:='三行二列';
ExcelApp.Cells[3,3].Value:='三行三列';
ExcelApp.Cells[3,4].Value:='三行四列';
ExcelApp.Cells[4,2].Value:='四行二列';
ExcelApp.Cells[4,3].Value:='四行三列';
ExcelApp.Cells[4,4].Value:='四行四列';
//ExcelApp.ActiveSheet.Range['B3:D4'].Value.CopyToClipBoard;
ExcelApp.activeSheet.Cells[1,4].ClearContents; //清除一行四列的内容,activeSheet可以省略
Excelapp.Rows[3].font.Name:='隶书'; //这里Rows前省略了activeSheet,但针对也只是当前工作表而非整个工作簿
ExcelApp.Rows[3].font.Color:=clBlue;
ExcelApp.Rows[3].Font.Bold:=True;
ExcelApp.Rows[3].Font.UnderLine:=True;
ExcelApp.Range['B3:D4'].Copy;
RichEdit1.PasteFromClipboard;
//ExcelApp.ActiveSheet.PageSetup.CenterFooter:='第$P页';
//所有页面设置(PageSetup的属性)都不能进行,不知为何
//ExcelApp.ActiveSheet.PrintPreview; //打印预览
//ExcelApp.ActiveSheet.PrintOut; //直接打印输出
//if not ExcelApp.ActiveWorkBook.Saved then //工作表保存:
// ExcelApp.ActiveSheet.PrintPreview;
//ExcelApp.SaveAs( 'C:/Excel/Demo1.xls' ); //工作表另存为
ExcelApp.ActiveWorkBook.Saved := True; // 放弃存盘
ExcelApp.WorkBooks.Close; //关闭工作簿
ExcelApp.Quit; //退出 Excel
end;
 
给你一个函数:
//输出到EXCEL
function WriteToExcel(DS: TDataSet; MSExcel: OleVariant; eRange: OleVariant):Boolean;
var
Count,I,Row: integer;
RangeName:string;
begin
with DS do
begin
if not Active then
begin
Result:=False;
Application.MessageBox('数据库没有打开','系统提示',MB_OK+MB_ICONINFORMATION );
Exit;
end;
end;
ds.first;
Result := True;
try
MSExcel := CreateOleObject('Excel.Application');
except
Application.MessageBox('没有EXCEL,请安装','系统提示',MB_OK+MB_ICONWARNING);
Result:=False;
end;
MSExcel.Visible := False;
MSExcel.WorkBooks.Add;
MSExcel.ScreenUpdating := False;
Count := DS.FieldCount-1;

eRange := MSExcel.Range['A1', 'A1']; //excel文件的第一行
with DS do begin
for I := 0 to Count do begin
eRange.Value := Fields.DisplayLabel; //将字段头写入excel文件的第一行
eRange := eRange.Next; //excel文件的下一列
end;
DisableControls;
First;
Row := 1;
while not eof do begin
Inc(Row); //row:=row+1; excel文件的下一行
RangeName := 'A'+IntToStr(Row);
eRange := MSExcel.Range[RangeName, RangeName];
for I := 0 to Count do begin
eRange.Value := ''''+Fields.AsString;
eRange := eRange.Next;
end;
Next;
end;
EnableControls;
end;
MSExcel.ScreenUpdating := True;
MSExcel.Visible := True;
Result := True;
MSExcel.Quit;
end;
 
有沒有哪個函數提供工作表名稱的修改,謝謝
 
用ADO,给我Email我发个例子给你。
 
真是不好意思,這幾天我一直外地,謝謝你,haofei
我的email是Donald_sh@etang.com
 
后退
顶部