DbGridToExcel(Delphi)
来源:互联网 发布:tcp常用端口 编辑:程序博客网 时间:2024/05/23 16:56
procedure TFrm_func.DbGridToExcel( ADg: TDBGrid );
var
xlApp, xlSheet: Variant;
ARow, iLoop: word;
FSaveDialog: TSaveDialog;
Cols:TStringList;
begin
if ADg.DataSource.DataSet.IsEmpty then
begin
Application.MessageBox( PChar( '没有可导出的数据。' ), PChar( '提示' ), MB_OK +
MB_ICONINFORMATION );
Exit;
end;
try
FSaveDialog := TSaveDialog.Create( Self );
FSaveDialog.Filter :=
'Excel 文档 (*.xls)|*.XLS|Text files (*.txt)|*.TXT|Comma separated values (*.csv)|*.CSV|HTML file (*.htm)|*.HTM|Word 文档 (*.rtf)|*.RTF';
if FSaveDialog.Execute and ( trim( FSaveDialog.FileName ) <> '' ) then
begin
try
xlApp := CreateOleObject( 'Excel.Application' );
xlSheet := xlApp.WorkBooks.Add;
except
Application.MessageBox( PChar( '无法调用Excel' ), PChar( '错误' ), MB_OK +
MB_ICONSTOP );
Exit;
end;
Cols:=TStringList.Create;
// 表格标题
for iLoop := 0 to ADg.Columns.Count - 1 do
begin
xlSheet.WorkSheets[1].Cells[1, iLoop + 1] :=
ADg.Columns[iLoop].Title.Caption;
Cols.Add(ADg.Columns.Items[iLoop].FieldName);
end;
// 数据
ARow := 2;
with ADg.DataSource.DataSet do
begin
DisableControls;
First;
while not Eof do
begin
for iLoop := 0 to Fields.Count - 1 do
begin
if Cols.IndexOf(Fields[iLoop].FieldName)<>-1 then
xlSheet.WorkSheets[1].Cells[ARow,Cols.IndexOf(Fields[iLoop].FieldName)+1] := Fields[iLoop].Value;
// xlSheet.WorkSheets[1].Cells[ARow, iLoop + 1] := Fields[iLoop].Value;
end;
inc( ARow );
Next;
end;
First;
EnableControls;
xlSheet.SaveAs( trim( FSaveDialog.FileName ) );
Application.MessageBox( '导出完毕!', '提示', MB_IconExclamation );
finally
// xlSheet.Close;
xlApp.Visible := False;
xlApp.Quit;
xlApp := UnAssigned;
end;
end;
FSaveDialog.Destroy;
except
on e: exception do
Application.MessageBox( PChar( e.message ), '错误', MB_OK + MB_ICONSTOP );
end;
end;
var
xlApp, xlSheet: Variant;
ARow, iLoop: word;
FSaveDialog: TSaveDialog;
Cols:TStringList;
begin
if ADg.DataSource.DataSet.IsEmpty then
begin
Application.MessageBox( PChar( '没有可导出的数据。' ), PChar( '提示' ), MB_OK +
MB_ICONINFORMATION );
Exit;
end;
try
FSaveDialog := TSaveDialog.Create( Self );
FSaveDialog.Filter :=
'Excel 文档 (*.xls)|*.XLS|Text files (*.txt)|*.TXT|Comma separated values (*.csv)|*.CSV|HTML file (*.htm)|*.HTM|Word 文档 (*.rtf)|*.RTF';
if FSaveDialog.Execute and ( trim( FSaveDialog.FileName ) <> '' ) then
begin
try
xlApp := CreateOleObject( 'Excel.Application' );
xlSheet := xlApp.WorkBooks.Add;
except
Application.MessageBox( PChar( '无法调用Excel' ), PChar( '错误' ), MB_OK +
MB_ICONSTOP );
Exit;
end;
Cols:=TStringList.Create;
// 表格标题
for iLoop := 0 to ADg.Columns.Count - 1 do
begin
xlSheet.WorkSheets[1].Cells[1, iLoop + 1] :=
ADg.Columns[iLoop].Title.Caption;
Cols.Add(ADg.Columns.Items[iLoop].FieldName);
end;
// 数据
ARow := 2;
with ADg.DataSource.DataSet do
begin
DisableControls;
First;
while not Eof do
begin
for iLoop := 0 to Fields.Count - 1 do
begin
if Cols.IndexOf(Fields[iLoop].FieldName)<>-1 then
xlSheet.WorkSheets[1].Cells[ARow,Cols.IndexOf(Fields[iLoop].FieldName)+1] := Fields[iLoop].Value;
// xlSheet.WorkSheets[1].Cells[ARow, iLoop + 1] := Fields[iLoop].Value;
end;
inc( ARow );
Next;
end;
First;
EnableControls;
end;
FreeAndNil(Cols);
xlSheet.SaveAs( trim( FSaveDialog.FileName ) );
Application.MessageBox( '导出完毕!', '提示', MB_IconExclamation );
finally
// xlSheet.Close;
xlApp.Visible := False;
xlApp.Quit;
xlApp := UnAssigned;
end;
end;
FSaveDialog.Destroy;
except
on e: exception do
Application.MessageBox( PChar( e.message ), '错误', MB_OK + MB_ICONSTOP );
end;
end;
-------------------
一个更加通用的思路:AdoQueryToExcel
0 0
- DbGridToExcel(Delphi)
- dbgridtoexcel
- 打造最快的DBGridToExcel之预告:)
- DElphi
- Delphi
- delphi...
- Delphi~~
- Delphi @ ^
- Delphi
- delphi
- Delphi
- delphi
- Delphi
- Delphi
- Delphi
- DELPHI
- Delphi
- Delphi
- 类似于android短信校验码的demo
- 二叉树层次遍历与递归释放
- Android中程序与Service交互的方式——综述
- mysql存储过程使用CURSOR操作多列数据实用案例
- 获取当前应用的相对路径
- DbGridToExcel(Delphi)
- 设计模式(九)外观模式Facade(结构型)
- javaScript的性能优化
- Activity的四种launchMode 详细分析
- iOS开发的22个开发技巧
- Android之SDK Manager无法更新终极解决方案
- 使用Spring切面编程记录操作行为的日志
- DecimalFormat用法
- 利用三个点(trsf)来实现各种规则图形的实现