如何将DGGrid内容输出成EXCEL文件？？？ ( 积分: 40 )

如题，我用的是D5

如题，我用的是D5

var
eclapp,workbook,sheet:Olevariant ;
I,J,K,PZXHc:integer ;
SSSQ,DesPath:string;
begin
if SelectDirectory('选择目录', '', DesPath) then
begin
if Copy(DesPath, Length(DesPath), 1) <> '/' then
DesPath := DesPath + '/';
try

Eclapp :=CreateOleObject('Excel.Application');
workbook:=CreateOleObject('Excel.sheet');
workbook:=Eclapp.workbooks.add ;

MainData.pSQLresult('Select PZXH,SSSQQ from DM_PZXH ', FalseQuery);[red] //执行自己的sql[/red]
FalseQuery.First ;
ProgressBar1.Max := FalseQuery.RecordCount ;
for I:=1 to FalseQuery.RecordCountdo
begin
ProgressBar1.Position := I ;
PZXHc:= FalseQuery.fieldbyname('PZXH').AsInteger ;
SSSQ:= FalseQuery.fieldbyname('SSSQQ').AsString ;
MainData.pSQLresult('Select * from FPRZData ',DAOQuery1);[red] //执行自己的sql[/red]
Sheet:= workbook.sheets.add ;
Sheet.name:= Copy(SSSQ,1,6) ;

//设置表头
for J:= 1 to 11do
begin
Sheet.cells(1,J):= ExpT[J-1];
Sheet.Columns[J].ColumnWidth:= ColumnsW[J-1] ;//数组
end;

//设置表头的颜色和大小以及位置
Sheet.Rows[1].Font.Color := clBlue;
Sheet.Rows[1].Font.Size := 10 ;
Sheet.Rows[1].HorizontalAlignment := $FFFFEFF4 ;
//让存放的东西居中

//导入数据
DAOQuery1.First ;
for J:=1 to DAOQuery1.RecordCountdo
begin
for K:=1 to DAOQuery1.FieldCountdo
begin
Sheet.cells(J+1,K):=DAOQuery1.Fields[K-1].AsString ;
Sheet.Rows[J+1].Font.Size := 10 ;
end;
DAOQuery1.Next ;
end;
FalseQuery.Next ;
end;

try
workbook.SaveAs(DesPath+'远程认证增值税发票明细清单.xls' );
workbook.close ;
eclapp.quit ;
except
end;

except
MessageBox(0,'您的机器可能还没有安装Execl或是导出时产生了异常，不能进行导出！','提示',MB_ICONINFORMATION);
end;
end;
end;

var
sl:tstringlist;
i:integer;
tmpstr:string;
begin
sl:=tstringlist.create;
try
with dbgrid1.datasource.datasetdo
begin
tmpstr:=fields[0].FullName;
for i:=1 to fieldcount-1do
tmpstr:=tmpstr+#9+fields.FullName;
sl.Add(tmpstr);
dbgrid1.datasource.dataset.first;
while not eofdo
begin
tmpstr:=fields[0].AsString;
for i:=1 to fieldcount-1do
tmpstr:=tmpstr+#9+fields.asstring;
sl.Add(tmpstr);
next;
end;
sl.SaveToFile('d:/aaa.xls');
end;
finally
sl.free;
end;
end;

增强型DBGrid2Excel-- 支持标题粗体,对齐格式与避免科学计算法 选择自do
gbear2000 的 Blog
关键字 增强型DBGrid2Excel-- 支持标题粗体,对齐格式与避免科学计算法
出处

unit dbgrid2excel;
{
功能描述：把DBGrid输出到Excel表格（支持多Sheet）
调用格式：DBGridToExcel([DBGrid1, DBGrid2]);
对于数字用AsString, 其它可能含有格式的文本用DisplayText
长数字字符 的Tag C_LongNumber_FieldTag = 9;
避免科学计算格式，如身份证号的显示
自动采用对齐属性, 标题粗体

}
interface
uses
classes, comctrls, stdctrls, windows, Dialogs, controls, SysUtils,
Db,DBGrids,forms,ComObj,Variants;
const
C_LongNumber_FieldTag = 9;
//这些不可运算文字可能含有格式
function MayHasFormatText(const AFieldType:TFieldType):Boolean;
procedure DBGridToExcel(Args: array of const);
implementation
function MayHasFormatText(const AFieldType:TFieldType):Boolean;
begin
Result := AFieldType in
[ftBoolean, ftDate, ftTime, ftDateTime, ftTimeStamp,
ftString, ftFixedChar, ftWideString] ;
end;

{
功能描述：把DBGrid输出到Excel表格（支持多Sheet）
调用格式：DBGridToExcel([DBGrid1, DBGrid2]);
}
procedure DBGridToExcel(Args: array of const);
const
xlHAlignCenter = -4108;
xlHAlignLeft = -4131;
xlHAlignRight = -4152;
var
iCount, jCount: Integer;
XLApp: Variant;
Sheet: Variant;
I: Integer;
BK : TBookMark;
DataSet:TDataSet;
Col : TColumn;
CellStr : string;
GAL :TAlignment;
EAL : 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) to High(Args)do
begin
XLApp.WorkBooks[1].WorkSheets[I+1].Name := TDBGrid(Args.VObject).Name;
Sheet := XLApp.Workbooks[1].WorkSheets[TDBGrid(Args.VObject).Name];
if not TDBGrid(Args.VObject).DataSource.DataSet.Active then
begin
Screen.Cursor := crDefault;
Exit;
end;
DataSet := TDBGrid(Args.VObject).DataSource.DataSet;
DataSet.DisableControls;
BK := DataSet.GetBookmark();
DataSet.First;
//标题
for iCount := 0 to TDBGrid(Args.VObject).Columns.Count - 1do
begin
Col := TDBGrid(Args.VObject).Columns.Items[iCount];
Sheet.Cells[1, iCount + 1] := Col.Title.Caption;
Sheet.Cells[1, iCount + 1].Font.Bold :=True ;//粗体
GAL := Col.Alignment;
if GAL = taLeftJustify then
EAL := xlHAlignLeft
else
if GAL = taCenter then
EAL := xlHAlignCenter
else
EAL := xlHAlignRight;
//列数据对齐格式
Sheet.Columns[iCount + 1].HorizontalAlignment := EAL ;
//列标题对齐格式
Sheet.Cells[1, iCount + 1].HorizontalAlignment := xlHAlignCenter;
//自定义格式, 避免把长数字字符转换为科学记数法
if Col.Field.Tag=C_LongNumber_FieldTag then
Sheet.Columns[iCount + 1].NumberFormatLocal :='@';
end;
//数据
jCount := 1;
while not DataSet.Eofdo
begin
for iCount := 0 to TDBGrid(Args.VObject).Columns.Count - 1do
begin
Col := TDBGrid(Args.VObject).Columns.Items[iCount];
if MayHasFormatText(Col.Field.DataType) then
CellStr := Col.Field.DisplayText
else
CellStr:= Col.Field.AsString;
Sheet.Cells[jCount + 1, iCount + 1] := CellStr;
end;
Inc(jCount);
DataSet.Next;
Application.ProcessMessages;
end;
DataSet.GotoBookmark(BK);
DataSet.FreeBookmark(BK);
DataSet.EnableControls;
XlApp.Visible := True;
//用户关掉, 就可以关掉内存中的Excel试验通过2005.2.5
Sheet := unAssigned;
//可以不要
end;
Screen.Cursor := crDefault;
end;

end.


作者Blog：http://blog.csdn.net/dogbear2000/

unit Excel;
interface
uses DB,comobj;
Function DbtoExcel(FromDb:TDataSet;toExcelFileName:string):boolean;
implementation
Function DbtoExcel(FromDb:TDataSet;toExcelFileName:string):boolean;
var
eclApp,WorkBook:Variant;
xlsFileName:string;
i,j:integer;
begin
result:=true;
xlsFileName:=toExcelFilename;
try
//创建OLE对象Excel Application与 WorkBook
eclApp:=CreateOleObject('Excel.Application');
WorkBook:=CreateOleobject('Excel.Sheet');
except
Result:=false;
Exit;
end;
try
workBook:=eclApp.workBooks.Add;
eclapp.cells.select;
eclapp.Selection.NumberFormatLocal := '@';
for i:=0 to fromdb.fields.Count -1do
begin
eclApp.Cells(1,i+1):=fromdb.fields.DisplayName;
end;
fromdb.First ;
j:=2;
while not fromdb.Eofdo
begin
for i:=0 to fromdb.FieldCount -1do
eclApp.Cells(j,i+1):=fromdb.Fields.AsString;
j:=j+1;
fromdb.Next ;
end;
WorkBook.saveas(xlsFileName);
WorkBook.close;
eclApp.Quit;
except
eclApp.Quit;
result:=false;
end;
end;

end.


用法
DbtoExcel(dbgrid1.datasource.DataSet,'c:/abc.xls')