procedure TFormfunction.gridtoexcel(sheetname,tablehead:string;DBGridvar:Tdbgrid;toexcel:boolean); var //将dbgrid里的内容导入excel表格里。 bm: TBook; col, row: Integer; sline: String; mem: TMemo; ExcelApp: Variant; begin Screen.Cursor := crHourglass; DBGridvar.DataSource.DataSet.DisableControls; bm := DBGridvar.DataSource.DataSet.GetBook; DBGridvar.DataSource.DataSet.First; // First we send the data to a memo // works faster than doing it directly to Excel mem := TMemo.Create(Self); mem.Visible := false; mem.Parent := self; mem.Clear; sline := ''; sline:=tablehead ; mem.lines.Add(sline); sline:=''; // add the info for the column names for col := 0 to DBGridvar.FieldCount-1 do sline := sline + DBGridvar.Columns[col].Title.Caption+ #9; mem.Lines.Add(sline); // get the data into the memo for row := 0 to DBGridvar.DataSource.DataSet.RecordCount-1 do begin sline := ''; for col := 0 to DBGridvar.FieldCount-1 do sline := sline + DBGridvar.Fields[col].AsString + #9; mem.Lines.Add(sline); DBGridvar.DataSource.DataSet.Next; if col>=300 then begin showmessage('最多只能导出300条记录!'); break; end; end;
// we copy the data to the clipboard mem.SelectAll; mem.CopyToClipboard; // if needed, send it to Excel // if not, we already have it in the clipboard if toExcel then begin ExcelApp := CreateOleObject('Excel.Application'); ExcelApp.WorkBooks.Add(xlWBatWorkSheet); if sheetname='' then sheetname:='sheet1'; ExcelApp.WorkBooks[1].WorkSheets[1].Name := sheetname; ExcelApp.Workbooks[1].WorkSheets[sheetname].Paste; ExcelApp.Visible := true; end;
1.select语句中可以写成类似select * into [excel 8.0;database=d:\aaa.xls].aa from aa,直接导出,速度很快,不过格式不好 2.可以用内存数据集的方法,速度还可以,支持格式设置,可以给你看我写的一段vb代码,自己想想怎么转delphi吧 Set excelapp = CreateObject("Excel.Application") With excelapp .Workbooks.Open App.Path & "\汇总表\" & fn rst.Open "select trim(村名) as 村名1,户数,混和户数,生活光户数,动力户数,水力户数,非居光户数,商业户数,供电量,总电量," & _ "0 as 抄见损失,生活光量,生活光费,非居光量,非居光费,动力电量,动力电费,水力电量,水力电费,商业电量,商业电费,总电费 from 所汇总 order by 标记", DE.cnn, adOpenStatic, adLockReadOnly, adCmdText Set excelsheet = .Sheets(rstSuo!局端所名 & rqqj(i)) With excelsheet .Cells(1, 1) = Left(rqqj(i), 4) & "年" & CInt(Mid(rqqj(i), 5)) & "月" & juName & "体改村用电经营情况统计表(" & rstSuo!局端所名 & ")" .Range("a4").CopyFromRecordset rst j = rst.RecordCount + 4 - 1 .Range("k4:k" & j).FormulaR1C1 = "=if(rc[-2]=0,"""",round((rc[-2]-rc[-1])/rc[-2]*100,2))" .Range("w4:w" & j).FormulaR1C1 = "=if(rc[-14]=0,"""",round(rc[-1]/rc[-14],2))" End With rst.Close .ActiveWorkbook.Close True .Quit end with 3.写单元格,巨慢,例子很多,自己搜
来自:yzhshi, 时间:2001-12-2 10:04:00, ID:758347 [code] 既然大家都在这里将自己的东西贴出来,那我就再贴一个,将DBGrid中的文件转换到Excel中或者转换到Txt中的控件。 我自己编写的,希望大家讨论一下。 unit DBGridExport; interface uses SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Db, DBGrids, Comobj, extctrls, comctrls, ActiveX;type TSpaceMark = (csComma, csSemicolon, csTab, csBlank, csEnter); TDBGridExport = class(TComponent) private FDB_Grid: TDBGrid; {读取DBGrid的源} FTxtFileName: string; {文本文件名} FSpaceMark: TSpaceMark; {间隔符号} FSpace_Ord: Integer; {间隔符号的Asc数值} FTitle: string; {显示的标题} FSheetName: string; {工作表标题} FExcel_Handle: OleVariant; {Excel的句柄} FWorkbook_Handle: OleVariant; {书签的句柄} FShow_Progress: Boolean; {否显示插入进度} FProgress_Form: TForm; {进度窗体} FRun_Excel_Form: TForm; {启动Excel提示窗口} FProgressBar: TProgressBar; {进度条} function Connect_Excel: Boolean; {启动Excel} function New_Workbook: Boolean; {插入新的工作博} function InsertData_To_Excel: Boolean; {插入数据} procedure Create_ProgressForm(AOwner: TComponent); {创建进度显示窗口} procedure Create_Run_Excel_Form(AOwner: TComponent); {创建启动Excel窗口} procedure SetSpaceMark(Value: TSpaceMark); {设置导出时的间隔符号} protected public constructor Create(AOwner: TComponent); override; {新建} destructor Destroy; override; {销毁} function Export_To_Excel: Boolean; overload; {导出到Excel中} function Export_To_Excel(DB_Grid: TDBGrid): Boolean; overload; function Export_To_Txt(NewFile: Boolean = True): Boolean; overload; {导出到文本文件中} function Export_To_Txt(FileName: string; NewFile: Boolean = True): Boolean; overload; function Export_To_Txt(DB_Grid: TDBGrid; NewFile: Boolean = True): Boolean; overload; function Export_To_Txt(FileName: string; DB_Grid: TDBGrid; NewFile: Boolean = True): Boolean; overload; published property DB_Grid: TDBGrid read FDB_Grid write FDB_Grid; property Show_Progress: Boolean read FShow_Progress write FShow_Progress; property TxtFileName: string read FTxtFileName write FTxtFileName; property SpaceMark: TSpaceMark read FSpaceMark write SetSpaceMark; property Title: string read FTitle write FTitle; property SheetName: string read FSheetName write FSheetName; end; procedure Register; implementation procedure Register; begin RegisterComponents('Stone', [TDBGridExport]); end;{-------------------------------------------------------------------------------} {新建} constructor TDBGridExport.Create(AOwner: TComponent); begin inherited Create(AOwner); FShow_Progress := True; FSpaceMark := csTab; end;{销毁} destructor TDBGridExport.Destroy; begin varClear(FExcel_Handle); varClear(FWorkbook_Handle); inherited Destroy; end; {===============================================================================} {导出到文本文件中} function TDBGridExport.Export_To_Txt(NewFile: Boolean = True): Boolean; var Txt: TStrings; Tmp_Str: string; data_Str: string; i, j: Integer; Column_name: string; Data_Set: TDataSet; book: pointer; Before_Scroll, Afrer_Scroll: TDataSetNotifyEvent; begin Result := False; if NewFile = True then FTxtFileName := ''; if FTxtFileName = '' then begin with TSaveDialog.Create(nil) do begin Title := '请选择输出文件名'; DefaultExt := 'txt'; Filter := '文本文件(*.Txt)|*.txt'; Options := [ofOverwritePrompt, ofHideReadOnly, ofPathMustExist, ofNoReadOnlyReturn, ofEnableSizing]; if Execute then FTxtFileName := FileName; Free; if FTxtFileName = '' then {如果没有选中文件,则直接推出} exit; end; if FTxtFileName = '' then begin raise exception.Create('没有指定输出文件'); Exit; end; end; if FDB_Grid = nil then raise exception.Create('请输入DBGrid名称'); Txt := TStringList.Create; try {显示插入进度} if FShow_Progress = True then begin Create_ProgressForm(nil); FProgress_Form.Show; end; {第一行,插入标题} Tmp_Str := ''; //FDB_Grid.Columns[0].Title.Caption; for i := 1 to FDB_Grid.Columns.Count do if FDB_Grid.Columns[i - 1].Visible = True then Tmp_Str := Tmp_Str + FDB_Grid.Columns[i - 1].Title.Caption + Chr(FSpace_Ord); Tmp_Str := Copy(Tmp_Str, 1, Length(Tmp_Str) - 1); Txt.Add(Tmp_Str); {插入DBGrid中的数据} Data_Set := FDB_Grid.DataSource.DataSet; {记忆当前位置并取消任何事件} // new(book); book := Data_Set.GetBook; Data_Set.DisableControls; Before_Scroll := Data_Set.BeforeScroll; Afrer_Scroll := Data_Set.AfterScroll; Data_Set.BeforeScroll := nil; Data_Set.AfterScroll := nil; if FShow_Progress = True then begin Data_Set.Last; FProgress_Form.Refresh; FProgressBar.Max := Data_Set.RecordCount; end; {插入DBGrid中的所有字段} Data_Set.First; j := 2; while not Data_Set.Eof do begin if FShow_Progress = True then FProgressBar.Position := j - 2; Column_name := FDB_Grid.Columns[0].FieldName; Tmp_Str := ''; //Data_Set.FieldByName(Column_name).AsString; for i := 1 to FDB_Grid.Columns.Count do if FDB_Grid.Columns[i - 1].Visible = True then begin data_Str := FDB_Grid.Fields[i - 1].DisplayText; Tmp_Str := Tmp_Str + data_Str + Chr(FSpace_Ord); end; Tmp_Str := Copy(Tmp_Str, 1, Length(Tmp_Str) - 1); Txt.Add(Tmp_Str); j := j + 1; Data_Set.Next; end; {恢复原始事件以及标志位置} Data_Set.GotoBook(book); Data_Set.FreeBook(book); // dispose(book); Data_Set.EnableControls; Data_Set.BeforeScroll := Before_Scroll; Data_Set.AfterScroll := Afrer_Scroll; {写到文件} Txt.SaveToFile(FTxtFileName); Result := True; finally Txt.Free; if FShow_Progress = True then begin FProgress_Form.Free; FProgress_Form := nil; end; end; end;function TDBGridExport.Export_To_Txt(FileName: string; NewFile: Boolean = True): Boolean; begin FTxtFileName := FileName; Result := Export_To_Txt(NewFile); end;function TDBGridExport.Export_To_Txt(DB_Grid: TDBGrid; NewFile: Boolean = True): Boolean; begin FDB_Grid := DB_Grid; Result := Export_To_Txt(NewFile); end;function TDBGridExport.Export_To_Txt(FileName: string; DB_Grid: TDBGrid; NewFile: Boolean = True): Boolean; begin FTxtFileName := FileName; FDB_Grid := DB_Grid; Result := Export_To_Txt(NewFile); end;{-------------------------------------------------------------------------------} {设置导出时的间隔符号} procedure TDBGridExport.SetSpaceMark(Value: TSpaceMark); begin FSpaceMark := Value; case Value of csComma: FSpace_Ord := ord(','); csSemicolon: FSpace_Ord := ord(';'); csTab: FSpace_Ord := 9; csBlank: FSpace_Ord := 32; csEnter: FSpace_Ord := 13; end; end;
{导出到Excel中} function TDBGridExport.Export_To_Excel: Boolean; begin if FDB_Grid = nil then raise exception.Create('请输入DBGrid名称'); Result := False; if Connect_Excel = True then if New_Workbook = True then if InsertData_To_Excel = True then Result := True; end; function TDBGridExport.Export_To_Excel(DB_Grid: TDBGrid): Boolean; begin FDB_Grid := DB_Grid; Result := Export_To_Excel; end; {启动Excel} function TDBGridExport.Connect_Excel: Boolean; function My_GetActiveOleObject(const ClassName: string; out Ole_Handle: IDispatch): Boolean; {连接Ole对象} var //IDispatch ClassID: TCLSID; Unknown: IUnknown; l_Result: HResult; begin Result := False; l_Result := CLSIDFromProgID(PWideChar(WideString(ClassName)), ClassID); if (l_Result and $80000000) = 0 then begin l_Result := GetActiveObject(ClassID, nil, Unknown); if (l_Result and $80000000) = 0 then begin l_Result := Unknown.QueryInterface(IDispatch, Ole_Handle); if (l_Result and $80000000) = 0 then Result := True; end; end; end;
function My_CreateOleObject(const ClassName: string; out Ole_Handle: IDispatch): Boolean;{创建OLE对象} var ClassID: TCLSID; l_Result: HResult; begin Result := False; l_Result := CLSIDFromProgID(PWideChar(WideString(ClassName)), ClassID); if (l_Result and $80000000) = 0 then begin l_Result := CoCreateInstance(ClassID, nil, CLSCTX_INPROC_SERVER or CLSCTX_LOCAL_SERVER, IDispatch, Ole_Handle); if (l_Result and $80000000) = 0 then Result := True; end; end; var l_Excel_Handle: IDispatch; begin if FShow_Progress = True then begin Create_Run_Excel_Form(nil); FRun_Excel_Form.Show; end; if My_GetActiveOleObject('Excel.Application', l_Excel_Handle) = False then if My_CreateOleObject('Excel.Application', l_Excel_Handle) = False then begin FRun_Excel_Form.Free; FRun_Excel_Form := nil; raise exception.Create('启动Excel失败,可能没有安装Excel!'); Result := False; Exit; end; FExcel_Handle := l_Excel_Handle; if FShow_Progress = True then begin FRun_Excel_Form.Free; FRun_Excel_Form := nil; end; Result := True; end; function TDBGridExport.New_Workbook: Boolean;{插入新的工作博} var i: Integer; begin Result := True; try FWorkbook_Handle := FExcel_Handle.Workbooks.Add; except raise exception.Create('新建Excel工作表出错!'); Result := False; Exit; end; if FTitle <> '' then FWorkbook_Handle.Application.ActiveWindow.Caption := FTitle; if FSheetName <> '' then begin for i := 2 to FWorkbook_Handle.Sheets.Count do if FSheetName = FWorkbook_Handle.Sheets[i].Name then begin raise exception.Create('工作表命名重复!'); Result := False; exit; end; try FWorkbook_Handle.Sheets[1].Name := FSheetName; except raise exception.Create('工作表命名错误!'); Result := False; exit; end; end; end; function TDBGridExport.InsertData_To_Excel: Boolean;{插入数据} var i, j, k: Integer; data_Str: string; Column_name: string; Data_Set: TDataSet; book: pointer; Before_Scroll, Afrer_Scroll: TDataSetNotifyEvent; begin try if FShow_Progress = True then {显示插入进度} begin Create_ProgressForm(nil); FProgress_Form.Show; end; j := 1; {第一行,插入标题}{仅仅插入可见数据} for i := 1 to FDB_Grid.Columns.Count do if FDB_Grid.Columns[i - 1].Visible = True then begin FWorkbook_Handle.WorkSheets[1].Cells[1, j].Value := FDB_Grid.Columns[i - 1].Title.Caption; FWorkbook_Handle.WorkSheets[1].Columns[j].ColumnWidth := FDB_Grid.Columns[i - 1].Width div 6; j := j + 1 end; Data_Set := FDB_Grid.DataSource.DataSet; {插入DBGrid中的数据} // new(book); {记忆当前位置并取消任何事件} book := Data_Set.GetBook; Data_Set.DisableControls; Before_Scroll := Data_Set.BeforeScroll; Afrer_Scroll := Data_Set.AfterScroll; Data_Set.BeforeScroll := nil; Data_Set.AfterScroll := nil; if FShow_Progress = True then begin Data_Set.Last; FProgress_Form.Refresh; FProgressBar.Max := Data_Set.RecordCount; end; Data_Set.First; k := 2; while not Data_Set.Eof do begin if FShow_Progress = True then FProgressBar.Position := k; j := 1; for i := 1 to FDB_Grid.Columns.Count do begin if FDB_Grid.Columns[i - 1].Visible = True then begin Column_name := FDB_Grid.Columns[i - 1].FieldName; data_Str := FDB_Grid.Fields[i - 1].DisplayText; FWorkbook_Handle.WorkSheets[1].Cells[k, j].Value := data_Str; j := j + 1; end; end; k := k + 1; Data_Set.Next; end; Data_Set.GotoBook(book); {恢复原始事件以及标志位置} Data_Set.FreeBook(book); // dispose(book); Data_Set.EnableControls; Data_Set.BeforeScroll := Before_Scroll; Data_Set.AfterScroll := Afrer_Scroll; Result := True; finally FExcel_Handle.Visible := True; FExcel_Handle.Application.ScreenUpdating := True; if FShow_Progress = True then begin FProgress_Form.Free; FProgress_Form := nil; end; end; end; {=======================} {启动Excel时给出进度显示} procedure TDBGridExport.Create_Run_Excel_Form(AOwner: TComponent); var Panel: TPanel; Prompt: TLabel; {提示的标签} begin if assigned(FRun_Excel_Form) then exit; FRun_Excel_Form := TForm.Create(AOwner); with FRun_Excel_Form do begin try Font.Name := '宋体'; {设置字体} Font.Size := 9; BorderStyle := bsNone; Width := 300; Height := 100; BorderWidth := 2; Color := clBlue; Position := poScreenCenter; Panel := TPanel.Create(FRun_Excel_Form); with Panel do begin Parent := FRun_Excel_Form; Align := alClient; BevelInner := bvNone; BevelOuter := bvRaised; Caption := ''; end; Prompt := TLabel.Create(Panel); with Prompt do begin Parent := panel; AutoSize := True; Left := 25; Top := 25; Caption := '正在导出数据,请稍候……'; end; except end; end; end; {======================} {创建进度显示窗口} procedure TDBGridExport.Create_ProgressForm(AOwner: TComponent); var Panel: TPanel; Prompt: TLabel; {提示的标签} begin if assigned(FProgress_Form) then exit; FProgress_Form := TForm.Create(AOwner); with FProgress_Form do begin try Font.Name := '宋体'; {设置字体} Font.Size := 9; BorderStyle := bsNone; Width := 300; Height := 100; BorderWidth := 2; Color := clBlue; Position := poScreenCenter; Panel := TPanel.Create(FProgress_Form); with Panel do begin Parent := FProgress_Form; Align := alClient; BevelInner := bvNone; BevelOuter := bvRaised; Caption := ''; end; Prompt := TLabel.Create(Panel); with Prompt do begin Parent := panel; AutoSize := True; Left := 25; Top := 25; Caption := '正在导出数据,请稍候……'; end; FProgressBar := TProgressBar.Create(panel); with FProgressBar do begin Parent := panel; Left := 20; Top := 50; Height := 18; Width := 260; end; except end; end; end; end.
从dataset导入的方法-------------------------------------------------------------------------------- 作者:8chen8 来源: 类别:delphi-数据库开发 日期: 今日/总浏览: 1/33 uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ComCtrls, Buttons, StdCtrls, ExtCtrls, DB, DBTables,Excel2000,OleServer,ComObj, Grids, DBGrids, DBCtrls; var myexcel:variant; workbook:olevariant; worksheet:olevariant; begin try myexcel:=createoleobject('excel.application'); myexcel.application.workbooks.add; myexcel.caption:=q+'至'+w+'客情预订表'; myexcel.application.visible:=true; workbook:=myexcel.application.workbooks[1]; worksheet:=workbook.worksheets.item[1]; except showmessage('EXCEL不存在!'); end; i:=1; j:=4; if q<>w then worksheet.Cells(i,j):=q+'至'+w+'客情预订表' else worksheet.Cells(i,j):=q+'客情预订表'; i:=2; //EXECL表行号 n:=0;//query字段N序号 j:=1;//EXECL表列号 form23.Query1.First; for n:=0 to form23.Query1.FieldCount -1 do begin worksheet.Cells(i,j):=form23.Query1.fields[n].DisplayLabel; j:=j+1; end; i:=2; //EXECL表行号 n:=0;//query字段N序号 i:=2;//EXECL表行号 i:=2; form23.query1.first; while not form23.query1.eof do begin inc(i); for j:=0 to form23.query1.fieldcount-1 do worksheet.cells[i,j+1]:=form23.query1.fields[j].asstring; form23.query1.next; end;
var //将dbgrid里的内容导入excel表格里。
bm: TBook;
col, row: Integer;
sline: String;
mem: TMemo;
ExcelApp: Variant;
begin
Screen.Cursor := crHourglass;
DBGridvar.DataSource.DataSet.DisableControls;
bm := DBGridvar.DataSource.DataSet.GetBook;
DBGridvar.DataSource.DataSet.First;
// First we send the data to a memo
// works faster than doing it directly to Excel
mem := TMemo.Create(Self);
mem.Visible := false;
mem.Parent := self;
mem.Clear;
sline := '';
sline:=tablehead ;
mem.lines.Add(sline);
sline:='';
// add the info for the column names
for col := 0 to DBGridvar.FieldCount-1 do
sline := sline + DBGridvar.Columns[col].Title.Caption+ #9;
mem.Lines.Add(sline);
// get the data into the memo
for row := 0 to DBGridvar.DataSource.DataSet.RecordCount-1 do
begin
sline := '';
for col := 0 to DBGridvar.FieldCount-1 do
sline := sline + DBGridvar.Fields[col].AsString + #9;
mem.Lines.Add(sline);
DBGridvar.DataSource.DataSet.Next;
if col>=300 then
begin
showmessage('最多只能导出300条记录!');
break;
end;
end;
// we copy the data to the clipboard
mem.SelectAll;
mem.CopyToClipboard; // if needed, send it to Excel
// if not, we already have it in the clipboard
if toExcel then
begin
ExcelApp := CreateOleObject('Excel.Application');
ExcelApp.WorkBooks.Add(xlWBatWorkSheet);
if sheetname='' then
sheetname:='sheet1';
ExcelApp.WorkBooks[1].WorkSheets[1].Name := sheetname;
ExcelApp.Workbooks[1].WorkSheets[sheetname].Paste;
ExcelApp.Visible := true;
end;
FreeAndNil(mem);
// FreeAndNil(ExcelApp);
DBGridvar.DataSource.DataSet.GotoBook(bm);
DBGridvar.DataSource.DataSet.FreeBook(bm);
DBGridvar.DataSource.DataSet.EnableControls;
Screen.Cursor := crDefault;
end;
2.可以用内存数据集的方法,速度还可以,支持格式设置,可以给你看我写的一段vb代码,自己想想怎么转delphi吧
Set excelapp = CreateObject("Excel.Application")
With excelapp
.Workbooks.Open App.Path & "\汇总表\" & fn
rst.Open "select trim(村名) as 村名1,户数,混和户数,生活光户数,动力户数,水力户数,非居光户数,商业户数,供电量,总电量," & _
"0 as 抄见损失,生活光量,生活光费,非居光量,非居光费,动力电量,动力电费,水力电量,水力电费,商业电量,商业电费,总电费 from 所汇总 order by 标记", DE.cnn, adOpenStatic, adLockReadOnly, adCmdText
Set excelsheet = .Sheets(rstSuo!局端所名 & rqqj(i))
With excelsheet
.Cells(1, 1) = Left(rqqj(i), 4) & "年" & CInt(Mid(rqqj(i), 5)) & "月" & juName & "体改村用电经营情况统计表(" & rstSuo!局端所名 & ")"
.Range("a4").CopyFromRecordset rst
j = rst.RecordCount + 4 - 1
.Range("k4:k" & j).FormulaR1C1 = "=if(rc[-2]=0,"""",round((rc[-2]-rc[-1])/rc[-2]*100,2))"
.Range("w4:w" & j).FormulaR1C1 = "=if(rc[-14]=0,"""",round(rc[-1]/rc[-14],2))"
End With
rst.Close
.ActiveWorkbook.Close True
.Quit
end with
3.写单元格,巨慢,例子很多,自己搜
[code]
既然大家都在这里将自己的东西贴出来,那我就再贴一个,将DBGrid中的文件转换到Excel中或者转换到Txt中的控件。
我自己编写的,希望大家讨论一下。
unit DBGridExport;
interface
uses
SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Db, DBGrids, Comobj, extctrls, comctrls, ActiveX;type
TSpaceMark = (csComma, csSemicolon, csTab, csBlank, csEnter); TDBGridExport = class(TComponent)
private
FDB_Grid: TDBGrid; {读取DBGrid的源}
FTxtFileName: string; {文本文件名}
FSpaceMark: TSpaceMark; {间隔符号}
FSpace_Ord: Integer; {间隔符号的Asc数值}
FTitle: string; {显示的标题}
FSheetName: string; {工作表标题}
FExcel_Handle: OleVariant; {Excel的句柄} FWorkbook_Handle: OleVariant; {书签的句柄}
FShow_Progress: Boolean; {否显示插入进度} FProgress_Form: TForm; {进度窗体}
FRun_Excel_Form: TForm; {启动Excel提示窗口}
FProgressBar: TProgressBar; {进度条} function Connect_Excel: Boolean; {启动Excel}
function New_Workbook: Boolean; {插入新的工作博}
function InsertData_To_Excel: Boolean; {插入数据}
procedure Create_ProgressForm(AOwner: TComponent); {创建进度显示窗口}
procedure Create_Run_Excel_Form(AOwner: TComponent); {创建启动Excel窗口}
procedure SetSpaceMark(Value: TSpaceMark); {设置导出时的间隔符号}
protected
public
constructor Create(AOwner: TComponent); override; {新建}
destructor Destroy; override; {销毁}
function Export_To_Excel: Boolean; overload; {导出到Excel中}
function Export_To_Excel(DB_Grid: TDBGrid): Boolean; overload;
function Export_To_Txt(NewFile: Boolean = True): Boolean; overload; {导出到文本文件中}
function Export_To_Txt(FileName: string; NewFile: Boolean = True): Boolean; overload;
function Export_To_Txt(DB_Grid: TDBGrid; NewFile: Boolean = True): Boolean; overload;
function Export_To_Txt(FileName: string; DB_Grid: TDBGrid; NewFile: Boolean = True): Boolean; overload; published
property DB_Grid: TDBGrid read FDB_Grid write FDB_Grid;
property Show_Progress: Boolean read FShow_Progress write FShow_Progress;
property TxtFileName: string read FTxtFileName write FTxtFileName;
property SpaceMark: TSpaceMark read FSpaceMark write SetSpaceMark;
property Title: string read FTitle write FTitle;
property SheetName: string read FSheetName write FSheetName; end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Stone', [TDBGridExport]);
end;{-------------------------------------------------------------------------------}
{新建}
constructor TDBGridExport.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FShow_Progress := True;
FSpaceMark := csTab;
end;{销毁}
destructor TDBGridExport.Destroy;
begin
varClear(FExcel_Handle);
varClear(FWorkbook_Handle);
inherited Destroy;
end;
{===============================================================================}
{导出到文本文件中}
function TDBGridExport.Export_To_Txt(NewFile: Boolean = True): Boolean;
var
Txt: TStrings;
Tmp_Str: string;
data_Str: string;
i, j: Integer;
Column_name: string;
Data_Set: TDataSet;
book: pointer;
Before_Scroll, Afrer_Scroll: TDataSetNotifyEvent;
begin
Result := False;
if NewFile = True then
FTxtFileName := '';
if FTxtFileName = '' then
begin
with TSaveDialog.Create(nil) do
begin
Title := '请选择输出文件名';
DefaultExt := 'txt';
Filter := '文本文件(*.Txt)|*.txt';
Options := [ofOverwritePrompt, ofHideReadOnly, ofPathMustExist, ofNoReadOnlyReturn, ofEnableSizing];
if Execute then
FTxtFileName := FileName;
Free;
if FTxtFileName = '' then {如果没有选中文件,则直接推出}
exit;
end; if FTxtFileName = '' then
begin
raise exception.Create('没有指定输出文件');
Exit;
end; end; if FDB_Grid = nil then
raise exception.Create('请输入DBGrid名称'); Txt := TStringList.Create;
try
{显示插入进度}
if FShow_Progress = True then
begin
Create_ProgressForm(nil);
FProgress_Form.Show;
end; {第一行,插入标题}
Tmp_Str := ''; //FDB_Grid.Columns[0].Title.Caption;
for i := 1 to FDB_Grid.Columns.Count do
if FDB_Grid.Columns[i - 1].Visible = True then
Tmp_Str := Tmp_Str + FDB_Grid.Columns[i - 1].Title.Caption + Chr(FSpace_Ord);
Tmp_Str := Copy(Tmp_Str, 1, Length(Tmp_Str) - 1);
Txt.Add(Tmp_Str);
{插入DBGrid中的数据}
Data_Set := FDB_Grid.DataSource.DataSet;
{记忆当前位置并取消任何事件}
// new(book);
book := Data_Set.GetBook;
Data_Set.DisableControls;
Before_Scroll := Data_Set.BeforeScroll;
Afrer_Scroll := Data_Set.AfterScroll;
Data_Set.BeforeScroll := nil;
Data_Set.AfterScroll := nil;
if FShow_Progress = True then
begin
Data_Set.Last;
FProgress_Form.Refresh;
FProgressBar.Max := Data_Set.RecordCount;
end;
{插入DBGrid中的所有字段}
Data_Set.First;
j := 2;
while not Data_Set.Eof do
begin
if FShow_Progress = True then
FProgressBar.Position := j - 2;
Column_name := FDB_Grid.Columns[0].FieldName; Tmp_Str := ''; //Data_Set.FieldByName(Column_name).AsString;
for i := 1 to FDB_Grid.Columns.Count do
if FDB_Grid.Columns[i - 1].Visible = True then
begin
data_Str := FDB_Grid.Fields[i - 1].DisplayText;
Tmp_Str := Tmp_Str + data_Str + Chr(FSpace_Ord);
end;
Tmp_Str := Copy(Tmp_Str, 1, Length(Tmp_Str) - 1);
Txt.Add(Tmp_Str);
j := j + 1;
Data_Set.Next;
end;
{恢复原始事件以及标志位置}
Data_Set.GotoBook(book);
Data_Set.FreeBook(book);
// dispose(book);
Data_Set.EnableControls;
Data_Set.BeforeScroll := Before_Scroll;
Data_Set.AfterScroll := Afrer_Scroll;
{写到文件}
Txt.SaveToFile(FTxtFileName);
Result := True;
finally
Txt.Free;
if FShow_Progress = True then
begin
FProgress_Form.Free;
FProgress_Form := nil;
end;
end;
end;function TDBGridExport.Export_To_Txt(FileName: string; NewFile: Boolean = True): Boolean;
begin
FTxtFileName := FileName;
Result := Export_To_Txt(NewFile);
end;function TDBGridExport.Export_To_Txt(DB_Grid: TDBGrid; NewFile: Boolean = True): Boolean;
begin
FDB_Grid := DB_Grid;
Result := Export_To_Txt(NewFile);
end;function TDBGridExport.Export_To_Txt(FileName: string; DB_Grid: TDBGrid; NewFile: Boolean = True): Boolean;
begin
FTxtFileName := FileName;
FDB_Grid := DB_Grid;
Result := Export_To_Txt(NewFile);
end;{-------------------------------------------------------------------------------}
{设置导出时的间隔符号}
procedure TDBGridExport.SetSpaceMark(Value: TSpaceMark);
begin
FSpaceMark := Value;
case Value of
csComma: FSpace_Ord := ord(',');
csSemicolon: FSpace_Ord := ord(';');
csTab: FSpace_Ord := 9;
csBlank: FSpace_Ord := 32;
csEnter: FSpace_Ord := 13;
end;
end;
function TDBGridExport.Export_To_Excel: Boolean;
begin
if FDB_Grid = nil then
raise exception.Create('请输入DBGrid名称');
Result := False;
if Connect_Excel = True then
if New_Workbook = True then
if InsertData_To_Excel = True then
Result := True;
end;
function TDBGridExport.Export_To_Excel(DB_Grid: TDBGrid): Boolean;
begin
FDB_Grid := DB_Grid;
Result := Export_To_Excel;
end;
{启动Excel}
function TDBGridExport.Connect_Excel: Boolean;
function My_GetActiveOleObject(const ClassName: string; out Ole_Handle: IDispatch): Boolean; {连接Ole对象}
var //IDispatch
ClassID: TCLSID;
Unknown: IUnknown;
l_Result: HResult;
begin
Result := False;
l_Result := CLSIDFromProgID(PWideChar(WideString(ClassName)), ClassID);
if (l_Result and $80000000) = 0 then
begin
l_Result := GetActiveObject(ClassID, nil, Unknown);
if (l_Result and $80000000) = 0 then
begin
l_Result := Unknown.QueryInterface(IDispatch, Ole_Handle);
if (l_Result and $80000000) = 0 then
Result := True;
end;
end;
end;
function My_CreateOleObject(const ClassName: string; out Ole_Handle: IDispatch): Boolean;{创建OLE对象}
var
ClassID: TCLSID;
l_Result: HResult;
begin
Result := False;
l_Result := CLSIDFromProgID(PWideChar(WideString(ClassName)), ClassID);
if (l_Result and $80000000) = 0 then
begin
l_Result := CoCreateInstance(ClassID, nil, CLSCTX_INPROC_SERVER or
CLSCTX_LOCAL_SERVER, IDispatch, Ole_Handle);
if (l_Result and $80000000) = 0 then
Result := True;
end;
end;
var
l_Excel_Handle: IDispatch;
begin
if FShow_Progress = True then
begin
Create_Run_Excel_Form(nil);
FRun_Excel_Form.Show;
end;
if My_GetActiveOleObject('Excel.Application', l_Excel_Handle) = False then
if My_CreateOleObject('Excel.Application', l_Excel_Handle) = False then
begin
FRun_Excel_Form.Free;
FRun_Excel_Form := nil;
raise exception.Create('启动Excel失败,可能没有安装Excel!');
Result := False;
Exit;
end;
FExcel_Handle := l_Excel_Handle;
if FShow_Progress = True then
begin
FRun_Excel_Form.Free;
FRun_Excel_Form := nil;
end;
Result := True;
end;
function TDBGridExport.New_Workbook: Boolean;{插入新的工作博}
var
i: Integer;
begin
Result := True;
try
FWorkbook_Handle := FExcel_Handle.Workbooks.Add;
except
raise exception.Create('新建Excel工作表出错!');
Result := False;
Exit;
end;
if FTitle <> '' then
FWorkbook_Handle.Application.ActiveWindow.Caption := FTitle;
if FSheetName <> '' then
begin
for i := 2 to FWorkbook_Handle.Sheets.Count do
if FSheetName = FWorkbook_Handle.Sheets[i].Name then
begin
raise exception.Create('工作表命名重复!');
Result := False;
exit;
end;
try
FWorkbook_Handle.Sheets[1].Name := FSheetName;
except
raise exception.Create('工作表命名错误!');
Result := False;
exit;
end;
end;
end;
function TDBGridExport.InsertData_To_Excel: Boolean;{插入数据}
var
i, j, k: Integer;
data_Str: string;
Column_name: string;
Data_Set: TDataSet;
book: pointer;
Before_Scroll, Afrer_Scroll: TDataSetNotifyEvent;
begin
try
if FShow_Progress = True then {显示插入进度}
begin
Create_ProgressForm(nil);
FProgress_Form.Show;
end;
j := 1; {第一行,插入标题}{仅仅插入可见数据}
for i := 1 to FDB_Grid.Columns.Count do
if FDB_Grid.Columns[i - 1].Visible = True then
begin
FWorkbook_Handle.WorkSheets[1].Cells[1, j].Value := FDB_Grid.Columns[i - 1].Title.Caption;
FWorkbook_Handle.WorkSheets[1].Columns[j].ColumnWidth := FDB_Grid.Columns[i - 1].Width div 6;
j := j + 1
end;
Data_Set := FDB_Grid.DataSource.DataSet; {插入DBGrid中的数据}
// new(book); {记忆当前位置并取消任何事件}
book := Data_Set.GetBook;
Data_Set.DisableControls;
Before_Scroll := Data_Set.BeforeScroll;
Afrer_Scroll := Data_Set.AfterScroll;
Data_Set.BeforeScroll := nil;
Data_Set.AfterScroll := nil;
if FShow_Progress = True then
begin
Data_Set.Last;
FProgress_Form.Refresh;
FProgressBar.Max := Data_Set.RecordCount;
end;
Data_Set.First;
k := 2;
while not Data_Set.Eof do
begin
if FShow_Progress = True then
FProgressBar.Position := k;
j := 1;
for i := 1 to FDB_Grid.Columns.Count do
begin
if FDB_Grid.Columns[i - 1].Visible = True then
begin
Column_name := FDB_Grid.Columns[i - 1].FieldName;
data_Str := FDB_Grid.Fields[i - 1].DisplayText;
FWorkbook_Handle.WorkSheets[1].Cells[k, j].Value := data_Str;
j := j + 1;
end;
end;
k := k + 1;
Data_Set.Next;
end;
Data_Set.GotoBook(book); {恢复原始事件以及标志位置}
Data_Set.FreeBook(book);
// dispose(book);
Data_Set.EnableControls;
Data_Set.BeforeScroll := Before_Scroll;
Data_Set.AfterScroll := Afrer_Scroll;
Result := True;
finally
FExcel_Handle.Visible := True;
FExcel_Handle.Application.ScreenUpdating := True;
if FShow_Progress = True then
begin
FProgress_Form.Free;
FProgress_Form := nil;
end;
end;
end;
{=======================}
{启动Excel时给出进度显示}
procedure TDBGridExport.Create_Run_Excel_Form(AOwner: TComponent);
var
Panel: TPanel;
Prompt: TLabel; {提示的标签}
begin
if assigned(FRun_Excel_Form) then exit;
FRun_Excel_Form := TForm.Create(AOwner);
with FRun_Excel_Form do
begin
try
Font.Name := '宋体'; {设置字体}
Font.Size := 9;
BorderStyle := bsNone;
Width := 300;
Height := 100;
BorderWidth := 2;
Color := clBlue;
Position := poScreenCenter;
Panel := TPanel.Create(FRun_Excel_Form);
with Panel do
begin
Parent := FRun_Excel_Form;
Align := alClient;
BevelInner := bvNone;
BevelOuter := bvRaised;
Caption := '';
end;
Prompt := TLabel.Create(Panel);
with Prompt do
begin
Parent := panel;
AutoSize := True;
Left := 25;
Top := 25;
Caption := '正在导出数据,请稍候……';
end;
except
end;
end;
end;
{======================}
{创建进度显示窗口}
procedure TDBGridExport.Create_ProgressForm(AOwner: TComponent);
var
Panel: TPanel;
Prompt: TLabel; {提示的标签}
begin
if assigned(FProgress_Form) then exit; FProgress_Form := TForm.Create(AOwner);
with FProgress_Form do
begin
try
Font.Name := '宋体'; {设置字体}
Font.Size := 9;
BorderStyle := bsNone;
Width := 300;
Height := 100;
BorderWidth := 2;
Color := clBlue;
Position := poScreenCenter;
Panel := TPanel.Create(FProgress_Form);
with Panel do
begin
Parent := FProgress_Form;
Align := alClient;
BevelInner := bvNone;
BevelOuter := bvRaised;
Caption := '';
end;
Prompt := TLabel.Create(Panel);
with Prompt do
begin
Parent := panel;
AutoSize := True;
Left := 25;
Top := 25;
Caption := '正在导出数据,请稍候……';
end;
FProgressBar := TProgressBar.Create(panel);
with FProgressBar do
begin
Parent := panel;
Left := 20;
Top := 50;
Height := 18;
Width := 260;
end;
except
end;
end;
end;
end.
作者:8chen8 来源: 类别:delphi-数据库开发 日期: 今日/总浏览: 1/33
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, Buttons, StdCtrls, ExtCtrls, DB, DBTables,Excel2000,OleServer,ComObj,
Grids, DBGrids, DBCtrls;
var
myexcel:variant;
workbook:olevariant;
worksheet:olevariant;
begin
try
myexcel:=createoleobject('excel.application');
myexcel.application.workbooks.add;
myexcel.caption:=q+'至'+w+'客情预订表';
myexcel.application.visible:=true;
workbook:=myexcel.application.workbooks[1];
worksheet:=workbook.worksheets.item[1];
except
showmessage('EXCEL不存在!');
end;
i:=1;
j:=4;
if q<>w then
worksheet.Cells(i,j):=q+'至'+w+'客情预订表'
else
worksheet.Cells(i,j):=q+'客情预订表';
i:=2; //EXECL表行号
n:=0;//query字段N序号
j:=1;//EXECL表列号
form23.Query1.First;
for n:=0 to form23.Query1.FieldCount -1 do
begin
worksheet.Cells(i,j):=form23.Query1.fields[n].DisplayLabel;
j:=j+1;
end;
i:=2; //EXECL表行号
n:=0;//query字段N序号
i:=2;//EXECL表行号 i:=2;
form23.query1.first;
while not form23.query1.eof do
begin
inc(i);
for j:=0 to form23.query1.fieldcount-1 do
worksheet.cells[i,j+1]:=form23.query1.fields[j].asstring;
form23.query1.next;
end;