获得当前窗体的DBGrid后导出Excel
供参考下：
unit DBGrid2Excel;
interface
uses
Windows, Variants, Classes, SysUtils, Forms, DB, DBGrids, ComObj;
type
TUpAniInfoProc = procedure (const sInfo: string;Position,FullNum: Integer) of object;
function DBGridToExcel(dgrSource: TDBGrid;
UpAniInfo: TUpAniInfoProc = nil; SaveFile: String = 'XyBook1.xls'): Integer;
implementation
const
MAX_SHEET_ROWS = 65536-1; //Excel每Sheet最大行数
MAX_VAR_ONCE = 1000; //一次导出的条数
function DBGridToExcel(dgrSource: TDBGrid; UpAniInfo: TUpAniInfoProc; SaveFile: String): Integer;
var //从DBGrid导出到Excel(改进至可以导入几乎无限的数据)
MyExcel, varCells: Variant;
MySheet, MyCells, Cell1, Cell2, Range: OleVariant;
iRow, iCol, iRealCol, iSheetIdx, iVarCount, iCurRow, iFieldCount: integer;
CurPos: TBookmark;
DataSet: TDataSet;
sFieldName: string;
begin //返回导出记录条数
DataSet := dgrSource.DataSource.DataSet;
DataSet.DisableControls;
CurPos := DataSet.GetBookmark;
DataSet.First;
MyExcel := CreateOleObject('Excel.Application');
MyExcel.WorkBooks.Add;
MyExcel.Visible := False;
if DataSet.RecordCount <= MAX_VAR_ONCE then
iVarCount := DataSet.RecordCount
else
iVarCount := MAX_VAR_ONCE;
iFieldCount := dgrSource.Columns.Count; //对DBGrid，只导出显示的列
for iCol:=0 to dgrSource.Columns.Count-1 do
if not dgrSource.Columns[iCol].Visible then //可能有不显示的列
Dec(iFieldCount);
varCells := VarArrayCreate([1,
iVarCount,
1,
iFieldCount], varVariant);
iSheetIdx := 1;
iRow := 0;
Result := 0;
while not DataSet.Eof do
begin
if (iRow = 0) or (iRow > MAX_SHEET_ROWS + 1) then
begin //新增一个Sheet
if iSheetIdx <= MyExcel.WorkBooks[1].WorkSheets.Count then
MySheet := MyExcel.WorkBooks[1].WorkSheets[iSheetIdx]
else
MySheet := MyExcel.WorkBooks[1].WorkSheets.Add(NULL, MySheet);//加在后面
MyCells := MySheet.Cells;
Inc(iSheetIdx);
iRow := 1;
iRealCol := 0;
for iCol := 1 to iFieldCount do
begin
MySheet.Cells[1, iCol].Font.Bold := True;
{MySheet.Select;
MySheet.Cells[iRow,iCol].Select;
MyExcel.Selection.Font.Bold := true;}//这种方法也可(Sheet.Select不可少)
while not dgrSource.Columns[iRealCol].Visible do
Inc(iRealCol); //跳过不可见的列
MySheet.Cells[1, iCol] := dgrSource.Columns[iRealCol].Title.Caption;
MySheet.Columns[iCol].ColumnWidth := //以下方法似乎算得还行
Integer(Round(dgrSource.Columns[iRealCol].Width * 2
/ abs(dgrSource.Font.Height)));
sFieldName := dgrSource.Columns[iRealCol].FieldName;
if (DataSet.FieldByName(sFieldName).DataType = ftString)
or (DataSet.FieldByName(sFieldName).DataType = ftWideString) then
begin //对于“字符串”型数据则设Excel单元格为“文本”型
MySheet.Columns[iCol].NumberFormatLocal := '@';
end;
Inc(iRealCol);
end;
Inc(iRow);
end;
iCurRow := 1;
while not DataSet.Eof do
begin
iRealCol := 0;
for iCol := 1 to iFieldCount do
begin
while not dgrSource.Columns[iRealCol].Visible do
Inc(iRealCol); //跳过不可见的列
sFieldName := dgrSource.Columns[iRealCol].FieldName;
varCells[iCurRow, iCol] := DataSet.FieldByName(sFieldName).AsString;
Inc(iRealCol);
end;
Inc(iRow);
Inc(iCurRow);
Inc(Result);
DataSet.Next;
if (iCurRow > iVarCount) or (iRow > MAX_SHEET_ROWS + 1) then
begin
if Assigned(UpAniInfo) then
UpAniInfo(Format('(已导出%d条,共%d条)', [Result, DataSet.RecordCount]),Result, DataSet.RecordCount); //显示已导出条数
Application.ProcessMessages;
Break;
end;
end;
Cell1 := MyCells.Item[iRow - iCurRow + 1, 1];
Cell2 := MyCells.Item[iRow - 1,
iFieldCount];
Range := MySheet.Range[Cell1 ,Cell2];
Range.Value := varCells;
if (iRow > MAX_SHEET_ROWS + 1) then //一个Sheet导出结束
begin
MySheet.Select;
MySheet.Cells[1, 1].Select; //使得每一Sheet均定位在第一格
end;
Cell1 := Unassigned;
Cell2 := Unassigned;
Range := Unassigned;
end;
MyCells := Unassigned;
varCells := Unassigned;
MyExcel.WorkBooks[1].WorkSheets[1].Select; //必须先选Sheet
MyExcel.WorkBooks[1].WorkSheets[1].Cells[1,1].Select;
MyExcel.Visible := False;
// MyExcel.WorkBooks[1].Saved := True;
MyExcel.DisplayAlerts:= False;
MyExcel.WorkBooks[1].SaveAs(SaveFile);
// MyExcel.WorkBooks[1].SaveCopyAs(SaveFile);
//// 调用Excel另存新档功能
//// MyExcel.Application.CommandBars.FindControl(ID:=748).Execute;
MyExcel.Quit;
MyExcel:= Unassigned;
if CurPos <> nil then
begin
DataSet.GotoBookmark(CurPos);
DataSet.FreeBookmark(CurPos);
end;
DataSet.EnableControls;
end;
end.
SaveDialog1.FileName := ''; //清空SaveDialog1默认文件名
if SaveDialog1.Execute then
begin //如果SaveDialog1正确执行
pExpClass := TDBGridEhExportAsXLS;
pExt := 'xls';
if pExpClass <> nil then //如果导出文件类型已经被正确设置
begin
pExpFile := trim(SaveDialog1.FileName);
pExpFileExt := Copy(pExpFile, Length(pExpFile) - 2, 3); //判断返回的文件名称是否已经包含正确的扩展名,如果没有则添加正确的扩展名
if UpperCase(pExpFileExt) <> UpperCase(pExt) then
pExpFile := pExpFile + '.' + pExt;
SaveDBGridEhToExportFile(pExpClass, DBGridEh2, pExpFile, True); //按现有设置导出全部数据。
showmessage('导出成功');
end;
end;
