将DBGrid的数据导出到Excel文件保存

(* 原作者： iamdream(delphi盒子) 修改： 不得闲 功能： 将DbGrid数据保存到Excel 参数： Grid指定表格 FileName指定要保存的文件名 MaxPageRowCount指定一页最多的支持行数 ShowProgress 指定是否显示进度条 用法： SaveDbGridAsExcel(DBGrid1,'C:/2.xls','表测试',2000); *) procedure SaveDbGridAsExcel(Grid: TDBGrid;const FileName,title: string; const MaxPageRowCount: Integer = 65535;const ShowProgress: Boolean = True); const MAX_VAR_ONCE = 1000; //一次导出的条数 var //返回导出记录条数 Excel, varCells: Variant; MySheet, MyCells, Cell1, Cell2, Range: OleVariant; iRow, iCol, iSheetIdx, iVarCount, iCurRow: integer; CurPos: TBookmark; ProgressForm: TForm; Prompt: TLabel; progressBar: TProgressBar; Panel : TPanel; Button : TButton; procedure ReSetObjEvent(OldEventAddr: pointer;NewEventValue: pointer;ReSetObject: TObject); begin TMethod(OldEventAddr^).Code := NewEventValue; TMethod(OldEventAddr^).Data := ReSetObject; end; procedure ButtonClick(BtnObject: TObject;Sender: TObject); begin TComponent(BtnObject).Tag := Integer(MessageBox(Application.Handle, '真的要终止数据的导出吗？','确认', MB_OKCANCEL + MB_ICONINFORMATION) = IDOK); end; procedure CreateProgressForm; begin ProgressForm := TForm.Create(nil); With ProgressForm do begin Font.Name := '宋体'; Font.Size := 10; BorderStyle := bsNone; Width := 280; Height := 120; BorderWidth := 1; Color := clBackground; Position := poOwnerFormCenter; end; Panel := TPanel.Create(ProgressForm); with Panel do { Create Panel } begin Parent := ProgressForm; Align := alClient; BevelInner := bvNone; BevelOuter := bvNone; Caption := ''; end; Prompt := TLabel.Create(Panel); with Prompt do { Create Label } begin Parent := Panel; Left := 20; Top := 25; Caption := '正在启动Excel，请稍候……'; end; progressBar := TProgressBar.Create(panel); with ProgressBar do { Create ProgressBar } begin Step := 1; Parent := Panel; Smooth := true; Left := 20; Top := 50; Height := 18; Width := 260; end; Button := TButton.Create(Panel); with Button do { Create Cancel Button } begin Parent := Panel; Left := 115; Top := 80; Caption := '关闭'; end; ReSetObjEvent(@@Button.OnClick,@ButtonClick,Button); ProgressForm.FormStyle := fsStayOnTop; ProgressForm.Show; ProgressForm.Update; end; begin if (Grid.DataSource <> nil) and (Grid.DataSource.DataSet <> nil) and Grid.DataSource.DataSet.Active then begin Grid.DataSource.DataSet.DisableControls; CurPos := Grid.DataSource.DataSet.GetBookmark; Grid.DataSource.DataSet.First; try if ShowProgress then begin CreateProgressForm; Button.Tag := 0; end; Excel := CreateOleObject('Excel.Application'); Excel.WorkBooks.Add; Excel.Visible := False; except Application.Messagebox('Excel 没有安装!','操作提示', MB_IConERROR + mb_Ok); Screen.Cursor := crDefault; Grid.DataSource.DataSet.GotoBookmark(CurPos); Grid.DataSource.DataSet.FreeBookmark(CurPos); Grid.DataSource.DataSet.EnableControls; if ProgressForm <> nil then ProgressForm.Free; exit; end; if Grid.DataSource.DataSet.RecordCount <= MAX_VAR_ONCE then iVarCount := Grid.DataSource.DataSet.RecordCount else iVarCount := MAX_VAR_ONCE; varCells := VarArrayCreate([1, iVarCount,1,Grid.FieldCount],varVariant); iSheetIdx := 1; iRow := 0; if ShowProgress then begin ProgressBar.Position := 0; Prompt.Caption := '请等待，正在导出数据……'; ProgressBar.Max := Grid.DataSource.DataSet.RecordCount; end; while (not Grid.DataSource.DataSet.Eof and not ShowProgress) or (not Grid.DataSource.DataSet.Eof and ShowProgress and (Button.Tag = 0)) do begin if (iRow = 0) or (iRow > MaxPageRowCount + 1) then begin if iSheetIdx <= Excel.WorkBooks[1].WorkSheets.Count then MySheet := Excel.WorkBooks[1].WorkSheets[iSheetIdx] else MySheet := Excel.WorkBooks[1].WorkSheets.Add(NULL, MySheet);//加在后面 MySheet.Name := Title + IntToStr(iSheetIdx); MyCells := MySheet.Cells; Inc(iSheetIdx); //开始新的数据表 iRow := 1; //写入表头 for iCol := 1 to Grid.FieldCount do begin MySheet.Cells[1, iCol] := Grid.Columns[iCol-1].Title.Caption; MySheet.Cells[1, iCol].Font.Bold := True; if (Grid.Fields[iCol - 1].DataType = ftString) or (Grid.Fields[iCol - 1].DataType = ftWideString) then //对于“字符串”型数据则设Excel单元格为“文本”型 MySheet.Columns[iCol].NumberFormatLocal := '@'; end; Inc(iRow); end; iCurRow := 1; while (not Grid.DataSource.DataSet.Eof and not ShowProgress) or (not Grid.DataSource.DataSet.Eof and ShowProgress and (Button.Tag = 0)) do begin for iCol := 1 to Grid.FieldCount do begin Application.ProcessMessages; if Grid.Fields[iCol - 1].IsBlob then varCells[iCurRow, iCol] := '二进制数据' else varCells[iCurRow, iCol] := Grid.Fields[iCol-1].AsString; end; Inc(iRow); Inc(iCurRow); if ShowProgress then ProgressBar.Position := ProgressBar.Position + 1; Application.ProcessMessages; Grid.DataSource.DataSet.Next; if (iCurRow > iVarCount) or (iRow > MaxPageRowCount + 1) then begin Application.ProcessMessages; Break; end; end; Cell1 := MyCells.Item[iRow - iCurRow + 1, 1]; Cell2 := MyCells.Item[iRow - 1,Grid.FieldCount]; Range := MySheet.Range[Cell1 ,Cell2]; Range.Value := varCells; MySheet.Columns.AutoFit; Cell1 := Unassigned; Cell2 := Unassigned; Range := Unassigned; Application.ProcessMessages; end; if (ShowProgress and (Button.Tag = 0)) or not ShowProgress then MySheet.saveas(FileName); MyCells := Unassigned; varCells := Unassigned; Excel.WorkBooks[1].Saved := True; MySheet.application.quit; Excel.quit; Excel := Unassigned; if CurPos <> nil then begin Grid.DataSource.DataSet.GotoBookmark(CurPos); Grid.DataSource.DataSet.FreeBookmark(CurPos); end; Grid.DataSource.DataSet.EnableControls; if ProgressForm <> nil then ProgressForm.Free; end; end; 本文来自CSDN博客，转载请标明出处：http://blog.csdn.net/suiyunonghen/archive/2009/05/21/4207564.aspx