数据导出为Excel格式
首先要创建一个公共单元,名字你们可以随便起。
以下是我创建的公共单元的全部代码:
unit UnitDatatoExcel;
interface
uses
Windows,Messages, SysUtils, Classes, Graphics,Controls, Forms,Dialogs,
DB, ComObj;
type
TKHTMLFormatCellEvent = procedure(Sender:TObject; CellRow,CellColumn: Integer; FieldName: string;
varCustomAttrs, CellData: string) of object;
TDataSetToExcel = class(TComponent)
private
FDataSet:TDataSet;
FOnFormatCell: TKHTMLFormatCellEvent;
public
constructorCreate(AOwner: TComponent); override;
destructorDestroy; override;
procedureTransfer(const FileName: string; Title: string = ');
published
propertyDataSet: TDataSet read FDataSet write FDataSet;
end;
implementation
constructor TDataSetToExcel.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FDataSet := nil;
end;
destructor TDataSetToExcel.Destroy;
begin
inherited;
end;
procedure TDataSetToExcel.Transfer(constFileName:string;Title:string = ');
var
ExcelApp, MyWorkBook: Variant;
i: byte;
j, a: integer;
s, k, b, CustomAttrs: string;
begin
try
ExcelApp :=CreateOleObject('Excel.Application');
MyWorkBook:= CreateOleObject('Excel.Sheet');
except
on Exceptiondo raise exception.Create('无法打开Excel文件,请确认已经安装Execl')
end;
MyWorkBook := ExcelApp.WorkBooks.Add;
MyWorkBook.WorkSheets[1].Range['A1:D1'].Merge(True);
MyWorkBook.WorkSheets[1].Range['A1:D2'].HorizontalAlignment :=$FFFFEFF4;
MyWorkBook.WorkSheets[1].Cells[1, 1].Value :=Title;
with FDataSet do
begin
i :=2;
for j := 0to FieldCount - 1 do
begin
if Fields[j].Visible then
begin
b := Fields[j].DisplayLabel;
CustomAttrs := ';
if Assigned(FOnFormatCell) then
FOnFormatCell(Self, 1, i,
Fields[j].FieldName, CustomAttrs, b);
MyWorkBook.WorkSheets[1].Cells[i, j + 1].Value := b;
end;
end;
i :=3;
Close;
Open;
First;
a :=2;
while notEof do
begin
for j := 0 to FieldCount - 1 do
begin
if Fields[j].Visible then
begin
CustomAttrs := ';
k := Fields[j].Text;
if Assigned(FOnFormatCell) then
FOnFormatCell(Self, i, a,
Fields[j].FieldName, CustomAttrs, k);
MyWorkBook.WorkSheets[1].Cells[i, j + 1].Value := k;
inc(a);
end;
end;
Inc(i);
Next;
end;
end;
s := 'A3:D' + IntToStr(i - 1);
s := 'A1:D' + IntToStr(i - 1);
MyWorkBook.WorkSheets[1].Columns[1].ColumnWidth:= 20;
MyWorkBook.WorkSheets[1].Columns[4].ColumnWidth:= 25;
MyWorkBook.WorkSheets[1].Rows[1].RowHeight :=50;
MyWorkBook.WorkSheets[1].Rows[1].VerticalAlignMent :=$FFFFEFF4;
MyWorkBook.WorkSheets[1].Range[s].Font.Name :='仿宋';
s := 'A2:D' + IntToStr(i - 1);
MyWorkBook.WorkSheets[1].Range[s].Borders.LineStyle := 1;
MyWorkBook.WorkSheets[1].PageSetup.CenterHorizontally :=True;
MyWorkBook.WorkSheets[1].PageSetup.PrintTitleRows := 'A1';
try
MyWorkBook.Saveas(FileName);
MyWorkBook.Close;
except
MyWorkBook.Close;
end;
ExcelApp.Quit;
ExcelApp := UnAssigned;
end;
end.
然后在调用它的单元里引用它就行了。
下面是调用它的代码:
procedure ToGetherExcel(NewData: TDataSet; NewString:string);
var
DataExcel: TDataSetToExcel;
saveDlg: TSaveDialog;
begin
saveDlg :=TSaveDialog.Create(nil); //创建一个存储对话框
DataExcel := TDataSetToExcel.Create(nil);
try
saveDlg.Filter := 'Execl 文件(*.XLS)|*.XLS';
saveDlg.DefaultExt := 'XLS';
saveDlg.FileName := NewString;
ifsaveDlg.Execute then
begin
DataExcel.DataSet := NewData; //连接的数据集
DataExcel.DataSet.DisableControls;
DataExcel.Transfer(saveDlg.FileName, NewString);
DataExcel.DataSet.EnableControls;
AlterMesg('导出完毕', '提示信息');
end;
finally
saveDlg.Free;
DataExcel.Free;
end;
end;
如果谁还有比着更好的办法,请告诉我,咱们共同进步:)
我给大伙发一个吧,调用过程,很方便,
这里DBGrid可更改为Query等与数据库相关的
procedure DBTOExcel(sDBGrid: DBGrid; Title,Fn: string);
//uses ComObj;
//sDBGrid:数据源
//Title:标题
//Fn:保存文件
var
ExcelApp: Variant;
i,j,k: Integer;
__ColStr,__s:String;
begin
try
ExcelApp :=CreateOleObject('Excel.Application');
except
//onException do raiseexception.Create('无法创建Xls文件,请确认是否安装EXCEL');
application.MessageBox('系统中的MS Excel软件没有安装或安装不正确!', '错误',MB_ICONERROR + MB_OK);
exit;
end;
ExcelApp.visible := False;
ExcelApp.WorkBooks.Add;
ExcelApp.caption := Title;
__ColStr:=Chr(65+sDBGrid.FieldCount-1);
ExcelApp.worksheets[1].range['A1:'+__ColStr+'1'].Merge(True);
//写入标题行
ExcelApp.Cells[1, 1].Value := Title;
ExcelApp.worksheets[1].range['A1:'+__ColStr+'3'].HorizontalAlignment:= $FFFFEFF4;
ExcelApp.worksheets[1].range['A1:'+__ColStr+'3'].VerticalAlignment:= $FFFFEFF4;
ExcelApp.worksheets[1].range['A2:B2'].Merge(True);
ExcelApp.worksheets[1].range['C2:D2'].Merge(True);
ExcelApp.Cells[2, 1].Value :='制表人:'+Myvalue.FUserName;
ExcelApp.Cells[2, 3].Value :='制表日期:'+DateToStr(Date());
for i := 1 to sDBGrid.FieldCount do begin
//各个字段的宽度
ExcelApp.worksheets[1].Columns[i].ColumnWidth:=sDBGrid.Fields[i-1].DisplayWidth;
//字段标题
ExcelApp.Cells[3, i].Value :=sDBGrid.Columns[i-1].Title.caption;
end;
ExcelApp.worksheets[1].Range['A1:'+__ColStr+'1'].Font.Name :='黑体';
ExcelApp.worksheets[1].Range['A1:'+__ColStr+'1'].Font.Size :=16;
ExcelApp.worksheets[1].range['A1:'+__ColStr+'3'].font.bold:=true;
ExcelApp.worksheets[1].Range['A2:'+__ColStr+'3'].Font.Size :=10;
i := 4;
k := 0;
sDBGrid.DataSource.DataSet.First;
while not sDBGrid.DataSource.DataSet.Eof dobegin
for j := 0to sDBGrid.FieldCount - 1 do begin
ExcelApp.Cells[i, j + 1].Value := sDBGrid.Fields[j].AsString;
end;
sDBGrid.DataSource.DataSet.Next;
i := i +1;
k:=k+1;
__s:='A3:'+__ColStr+IntToStr(i-1);
end;
sDBGrid.DataSource.DataSet.First;
ExcelApp.worksheets[1].Range[__s].HorizontalAlignment :=$FFFFEFF4;
ExcelApp.worksheets[1].Range[__s].VerticalAlignment :=$FFFFEFF4;
ExcelApp.worksheets[1].Range[__s].Font.Name :='宋体';
ExcelApp.worksheets[1].Range[__s].Font.Size :=10;
ExcelApp.worksheets[1].Range[__s].Borders.LineStyle := 1;
ExcelApp.ActiveSheet.PageSetup.RightMargin :=0.5/0.035;
ExcelApp.ActiveSheet.PageSetup.LeftMargin :=2/0.035;
ExcelApp.ActiveSheet.PageSetup.BottomMargin :=0.5/0.035;
ExcelApp.visible := True;
ExcelApp.ActiveCell.Cells.Select;
ExcelApp.Selection.Columns.AutoFit;
try
ExcelApp.ActiveWorkBook.SaveAs(Fn);
except
end;
end;
//导出数据到Excel
procedure ToExcel(DBGrid:TDBGrid);
var
ExcelApp: Variant;
i,j,k:integer;
FileName:string;
DlgSave:TsaveDialog;
Begin
DlgSave:=TsaveDialog.Create(nil);
DlgSave.Filter:='*.xls|*.xls';
if DlgSave.Execute then
Begin
application.ProcessMessages;
Filename:=DlgSave.FileName;
ExcelApp :=CreateOleObject( 'Excel.Application' );
ExcelApp.Caption :='能创监控系统日志数据';//'Microsoft Excel';
ExcelApp.WorkBooks.Add;
application.ProcessMessages;
ExcelApp.WorkSheets[1].Activate;
K:=1;
For i:=0 ToDBGrid.Columns.Count-1 Do
Begin
if DBGrid.Columns[i].Visible Then
Begin
ExcelApp.Cells[1,K]:=DBGrid.Columns[i].Title.Caption;
k:=k+1;
End;{if}
End;{for}
ExcelApp.rows[1].font.name:='宋体';
ExcelApp.rows[1].font.size:=10;
ExcelApp.rows[1].Font.Color:=clBlack;
ExcelApp.rows[1].Font.Bold:=true;
j:=1;
For i:=0 ToDBGrid.Columns.Count-1 Do
Begin
If DBGrid.Columns[i].Visible Then
Begin
ADOQuery_DB.First;
for k:=1 To ADOQuery_DB.RecordCount-1 Do
Begin
ExcelApp.Cells[K+1,j]:=ADOQuery_DB.FieldByName(DBGrid.Columns[i].FieldName).Asstring;
ADOQuery_DB.Next;
End;{for}
j:=j+1;
End;{if}
End;{for}
For I:=1 ToADOQuery_DB.recordcount Do
ExcelApp.rows[i].Font.SIZE:=9;
ExcelApp.Columns.AutoFit;
ExcelApp.ActiveWorkBook.SaveAs(FileName);
ExcelApp.WorkBooks.Close;
Application.MessageBox('数据导出成功....','数据导出',0);
ExcelApp.Quit;
ExcelApp:=Unassigned;
DlgSave.Destroy;
End;
end;
测试通过!
我可以发一段给你
先在程序上放上三个控件,TExcelApplication,TExcelWorkbook,TExcelWorkSheet,它们都在Server组件板上。
要控制Excel,就是采用自动化编程。以Excel作为自动化服务器。
首先,建立与自动化服务器的连接:
Excelapplication1.Connect;
Excelapplication1.Visible[0]:=true;
Excelapplication1.Caption:='你要的标题';
ExcelWorkbook1.ConnectTo(Excelapplication1.Workbooks.Add(null,0));
Excelworksheet1.ConnectTo(Excelworkbook1.Worksheets[0] as_worksheet) ;
然后就可以对Excel进行控件了:
从数据库导入数据:
Excel.cells.item[row,col]:=table1.field[i].value;
....
最后不要忘了断开连接
Excelapplication1.disconnect;
Excelapplication1.quit;
至今是delphi菜鸟
******************************************************************
如何把在dbgrid的指定几列导到excel表里?
我的做法:用listbox1显示dbgrid的所用供选择列,listbox2用来显示要导出的列:
procedure TForm1.FormCreate(Sender: TObject);
begin
if kadaoTable1.Active then
kadaoTable1.GetFieldNames(Listbox1.Items);
end;
procedure TForm1.addbitbtnClick(Sender: TObject);//选择字段
begin
try
if listbox1.Items.Count=0 then exit;
if listbox1.Selected[listbox1.ItemIndex]then
begin
Listbox2.Items.Add(Listbox1.Items[Listbox1.ItemIndex]);
Listbox1.Items.Delete(Listbox1.ItemIndex);
if Listbox2.Items.Count>=1then
DeleteBitBtn.Enabled:=True;
end;
except
showmessage('你没有选择相应字段!');
end;
end;
procedure TForm1.DeleteBitBtnClick(Sender: TObject);//撤消选择
begin
try
if Listbox2.Items.Count=0 then exit;
if listbox2.Selected[Listbox2.ItemIndex]then
begin
Listbox1.Items.Add(Listbox2.items[Listbox2.itemindex]);
Listbox2.Items.Delete(Listbox2.itemindex);
end;
if Listbox2.Items.Count=0then
DeleteBitBtn.Enabled:=False;
except
showmessage('你没有选择相应字段!');
end;
end;
procedure CopyDbDataToExcel(Args: array of const);
var
iCount, jCount: Integer;
XLApp: Variant;
Sheet: Variant;
I: Integer;
begin
Screen.Cursor := crHourGlass;
if not VarIsEmpty(XLApp) then
begin
XLApp.DisplayAlerts := False;
XLApp.Quit;
VarClear(XLApp);
end;
try
XLApp :=CreateOleObject('excel.Application');
except
Screen.Cursor := crDefault;
Exit;
end;
XLApp.WorkBooks.Add;
XLApp.SheetsInNewWorkbook := High(Args) +1;
for I := Low(Args) toHigh(Args) do
begin
XLApp.WorkBooks[1].WorkSheets[I+1].Name :=TDBGrid(Args[I].VObject).Name;
Sheet :=XLApp.Workbooks[1].WorkSheets[TDBGrid(Args[I].VObject).Name];
if notTDBGrid(Args[I].VObject).DataSource.DataSet.Active then
begin
Screen.Cursor := crDefault;
Exit;
end;
TDBGrid(Args[I].VObject).DataSource.DataSet.first;
for iCount:= 0 to TDBGrid(Args[I].VObject).Columns.Count - 1 do
Sheet.Cells[1, iCount + 1] :=TDBGrid(Args[I].VObject).Columns.Items[iCount].Title.Caption;
jCount := 1;
while notTDBGrid(Args[I].VObject).DataSource.DataSet.Eof do
begin
for iCount := 0 to TDBGrid(Args[I].VObject).Columns.Count - 1do
Sheet.Cells[jCount + 1, iCount + 1] :=TDBGrid(Args[I].VObject).Columns.Items[iCount].Field.AsString;
Inc(jCount);
TDBGrid(Args[I].VObject).DataSource.DataSet.Next;
end;
end;
XlApp.Visible := True;
Screen.Cursor := crDefault;
end;
procedure TForm1.BitBtn3Click(Sender: TObject);//导出操作
begin
CopyDbDataToExcel([DBGrid4]);
end;
我想解决问题有两种办法:一、直接修改CopyDbDataToExcel。二、实现dbgrid4显示的字段列与listbox2中字段同步,dbgrid4中的其余字段要删除掉,不是隐藏。也就是用listbox2中字段来控制哪些字段导入到excel表中呀,如何实现呀? 请高手指点!
*****************************
将dbgrid中数据导出到excel后,如何编写程序使excel的列宽调整为最适合的列宽?
ExcelWorkSheet1.Columns.AutoFit;
************************************
var
s:string;
i,j:integer;
begin
s:='d:\aa\aa.xls'; //文件名
if fileexists(s) then deletefile(s);
v:=CreateOLEObject('Excel.Application');//建立OLE对象
V.WorkBooks.Add;
if Checkbox1.Checked then
begin
V.Visible:=False;
//使Excel可见,并将本程序最小化,以观察Excel的运行情况
end
else
begin
V.Visible:=True; //True
end;
//使Excel窗口不可见
//Application.BringToFront; //程序前置
try
try
Cursor:=crSQLWait;
query1.DisableControls;
For i:=0 toquery1.FieldCount-1 do //字段数
//注意:Delphi中的数组的下标是从0开始的,
//而Excel的表格是从1开始编号
begin
V.Goto('R1'+'C'+IntToStr(i+1)); //Excel的表格是从1开始编号
V.ActiveCell.FormulaR1C1:=query1.Fields[i].FieldName;//传送字段名
end;
j:=2;
query1.First;
while notquery1.EOF do
begin
For i:=0 to query1.FieldCount-1 do //字段数
begin
V.Goto('R'+IntToStr(j)+'C'+IntToStr(i+1));
V.ActiveCell.FormulaR1C1:=query1.Fields[i].AsString;//传送内容
end;
query1.Next;
j:=j+1;
end;
//设置保护
ShowMessage('数据库到Excel的数据传输完毕!');
except//发生错误时
ShowMessage('没有发现Excel!');
end;
finally
Cursor:=crDefault;
query1.First;
query1.EnableControls;
end;
end;
//和上面的差不多,不过不是从DBGrid中导出的!上面的也不是,只是从Query中
导出来。我也想知从DBGrid 中怎么样导出来,或直接打印也行!
************************************************
直接使用Excel对象,它是标准的COM对象,可以在Delphi中引用的。
我给你一个函数:
function ExportDataToExcel(cds: TClientDataSet; dbGrid: TDBGrid;ExcelAppData: TExcelApplication;
Title, strWhere: String): Boolean;
var
sheet,Range: Variant;
i,j: Integer;
str,fVal: String;
begin
Result := False;
if (cds = nil) or (not cds.Active) thenExit;
try
ifExcelAppData.Tag = 1 then
begin
ExcelAppData.Disconnect;
ExcelAppData.Tag := 0;
end;
ExcelAppData.Connect;
ExcelAppData.Visible[0] := True;
ExcelAppData.Tag := 1;
except
ShowMessage('启动Excel失败,Excel可能没有安装。');
Abort;
end;
cds.DisableControls;
try
ifTrim(Title) = ' then Title := '查询结果';
ExcelAppData.Caption := Title;
ExcelAppData.Workbooks.Add(emptyparam,0);
sheet :=ExcelAppData.Workbooks[ExcelAppData.Workbooks.Count].Worksheets[1];
sheet.name := Title;
i :=(dbGrid.Columns.Count div 2) - 1;
if i< 1 then i:=1;
Sheet.Cells[1,i] := Title;
ExcelAppData.StandardFontSize[0] := 9; //设置表格字体
ifdbGrid.Columns.Count < 24 then
begin
str := Char(Ord('A') + dbGrid.Columns.Count -1); // 计算最后一列的列标
Range := Sheet.Range['A3:' + str + '3']; //取出表头的边界
Range.Columns.Interior.ColorIndex :=8; //设置表头的颜色
//计算表格区域
str := 'A3:' + str + IntToStr(cds.RecordCount + 3);
Range := Sheet.Range[str]; //取出表格数据区域边界
Range.Borders.LineStyle :=xlContinuous; // 设置表格的线条
end;
Sheet.Cells[2,1] := strWhere;//'日期:' + DateToStr(Date);
//写表头
for j := 0to dbGrid.Columns.Count -1 do
begin
Sheet.Cells[3,j + 1] :=dbGrid.Columns.Items[j].Title.Caption;
Sheet.Columns.Columns[j+1].ColumnWidth :=dbGrid.Columns.Items[j].Width div 6;
end;
//写表的内容
cds.First;
for i:= 4 tocds.RecordCount + 3 do
begin
for j := 0 to dbGrid.Columns.Count - 1 do
begin
fVal :=Trim(cds.FieldByName(dbGrid.Columns.Items[j].FieldName).AsString);
Sheet.Cells[i,j + 1] := fVal;
end;
cds.Next;
end;
Sleep(1000); //延时1秒,等待Excel处理完成
Result :=True;
except on E: Exception do
ShowMessage('数据导出时出现异常!' + E.Message);
end;
ExcelAppData.Disconnect;
cds.EnableControls;
end;