dbgrideh 中数据导出到excle 中(50)

如何添加一个button按钮，其功能是 ToExcel 将数据查询后显示在 DBgrideh 中，然后点击button按钮 将其导出到excel里 如何解决，请详细代码说明 谢谢

unit Unit1;interfaceuses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, GridsEh, DBGridEh, StdCtrls,DBGridEhImpExp;type TForm1 = class(TForm) DBGridEh1: TDBGridEh; Button3: TButton; procedure Button3Click(Sender: TObject); private { Private declarations } public { Public declarations } end;var Form1: TForm1;implementation{$R *.dfm}procedure TForm1.Button3Click(Sender: TObject);var ExpClass:TDBGridEhExportClass; Ext,strDate:String;beginstrDate:=formatdatetime('yyyy',DataTimer.DateTime)+formatdatetime('mm',DataTimer.DateTime)+formatdatetime('dd',DataTimer.DateTime-1); SaveDialog1.FileName := '考勤检查记录'+strDate; if SaveDialog1.Execute then begin case SaveDialog1.FilterIndex of 1: begin ExpClass := TDBGridEhExportAsXLS; Ext := 'xls'; end; 2: begin ExpClass := TDBGridEhExportAsCSV; Ext := 'csv'; end; 3: begin ExpClass := TDBGridEhExportAsText; Ext := 'txt'; end; //4: begin ExpClass := TDBGridEhExportAsHTML; Ext := 'html'; end; //5: begin ExpClass := TDBGridEhExportAsRTF; Ext := 'rtf'; end; else ExpClass := nil; Ext := ''; end; if ExpClass <> nil then begin if UpperCase(Copy(SaveDialog1.FileName,Length(SaveDialog1.FileName)-2,3)) <> UpperCase(Ext) then SaveDialog1.FileName := SaveDialog1.FileName + '.' + Ext; SaveDBGridEhToExportFile(ExpClass,dbjg, SaveDialog1.FileName,true); end; end;end;

dbjg 这个是什么

是 DBGridEh1

你这是在那个网站随便找的吧，我运行后根本就没数据，请看好我的要求再来粘贴好吗？？这样你是没法拿分的

或者直接procedure TForm1.Button3Click(Sender: TObject);begin SaveDBGridEhToExportFile(TDBGridEhExportAsXLS,DBGridEh1,FileName,True);end;

如果你直接就写procedure TForm1.Button3Click(Sender: TObject);begin SaveDBGridEhToExportFile(TDBGridEhExportAsXLS,DBGridEh1,FileName,True);end; 也不正确，应该现将数据写入到excel里 ，否则根本无法导出的

unit Unit1;测试通过~~interfaceuses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, Grids, DBGridEh, DB, ADODB, StdCtrls, Excel2000, OleServer, ExcelXP, GridsEh;type TForm1 = class(TForm) ADOConnection1: TADOConnection; ADOQuery1: TADOQuery; DataSource1: TDataSource; DBGridEh1: TDBGridEh; Panel1: TPanel; ComboBox1: TComboBox; Edit1: TEdit; Button1: TButton; Button2: TButton; ExcelApplication1: TExcelApplication; ExcelWorksheet1: TExcelWorksheet; ExcelWorkbook1: TExcelWorkbook; procedure Button2Click(Sender: TObject); private { Private declarations } public { Public declarations } end;var Form1: TForm1;implementationuses ExportMultiTitle;{$R *.dfm}procedure TForm1.Button2Click(Sender: TObject);var i,j:Integer; dT,dL,dR,dB:Integer; Ra:Variant;begin Try ExcelApplication1.Connect; ExcelWorkbook1.ConnectTo(ExcelApplication1.Workbooks.Add(EmptyParam,0)); ExcelWorkSheet1.ConnectTo(ExcelWorkBook1.Sheets[1] as _WorkSheet); ExcelApplication1.Caption := '调用 Microsoft Excel'; ExcelApplication1.Visible[0]:=True; ExportMyCell(ADOQuery1.Fields); for i:=0 to r-1 do for j:=0 to c-1 do if MyCells[i,j].Used then begin if (MyCells[i,j].Rect.Top=MyCells[i,j].Rect.Bottom) and (MyCells[i,j].Rect.Left=MyCells[i,j].Rect.Right) then begin dT:=MyCells[i,j].Rect.Top+1; dL:=MyCells[i,j].Rect.Left+1; ExcelWorksheet1.Cells.Item[dt,dl]:=MyCells[i,j].Text; end else begin dT:=MyCells[i,j].Rect.Top+1; dL:=MyCells[i,j].Rect.Left+1; dR:=MyCells[i,j].Rect.Right+1; dB:=MyCells[i,j].Rect.Bottom+1; ExcelWorksheet1.Cells.Item[dt,dl]:=MyCells[i,j].Text; Ra:=ExcelWorksheet1.Range[ExcelWorksheet1.Cells.Item[dt,dl],ExcelWorksheet1.Cells.Item[db,dr]]; Ra.MergeCells:=True; end; end; ExcelWorkSheet1.Columns.AutoFit; Finally ExcelWorkSheet1.Disconnect; ExcelWorkBook1.Disconnect; ExcelApplication1.Disconnect; Ra:=Unassigned; end;end;end.

ExcelApplication, ExcelWorkbook和ExcelWorksheet 请问 这三个控件在那里

servers页面~~

真是辛苦你了 在网上找了这么久 ，刚才我也找到了这个源码，你简化了一点 呵呵，这个分必须给你了，但是我运行的时候ExportMyCell 无法发现，我不知道是我那里出了问题

不好意思，我手上只有dbgrid转excel，就在网上找了一个dbgrideh例子修改了一下~~把你找到的源代码中的ExportMultiTitle.pas放到你的程序目录中引用，然后implementationuses ExportMultiTitle;//在此处引用ExportMultiTitle即可{$R *.dfm}

ExportMultiTitle.pas //单元代码，贴入文本文件，将文件名改为ExportMultiTitle，后缀名改为.pasunit ExportMultiTitle;interfaceuses Windows, DB;type PMyCell=^MyCell; MyCell=Record Text:String; ParentMyCell; Used:Boolean; Rect:TRect; end;var MyCells: Array of Array of MyCell; R,C:Integer;procedure ExportMyCell(AField:TFields); implementationprocedure ExportMyCell(AField:TFields); //取得列标题行数 function GetTitleRow(ColTitle:String):Integer; var ii:Integer; begin Result:=1; for ii:=1 to Length(ColTitle) do if ColTitle[ii]='|' then Result:=Result+1; end; Function GetMaxTitleRow(AFields:TFields):Integer; var ii,jj:Integer; begin Result:=1; for ii:=0 to AFields.Count-1 do begin jj:=GetTitleRow(AFields[ii].DisplayLabel); if Result<jj then Result:=jj; end; end; procedure initMycells; var i,j:Integer; begin SetLength(MyCells,R); for i:=0 to R-1 do begin SetLength(MyCells,C); for j:=0 to C-1 do begin MyCells[i,j].Text:=''; MyCells[i,j].Used:=True; MyCells[i,j].Rect.Left:=j; MyCells[i,j].Rect.Right:=j; MyCells[i,j].Rect.Top:=i; MyCells[i,j].Rect.Bottom:=i; if i=0 then MyCells[i,j].Parent:=nil else MyCells[i,j].Parent:=@MyCells[i-1,j]; end; end; end; procedure GetFieldToMycells(AFields:TFields); var i,j:Integer; TmpStr:String; begin initMycells; for i:=0 to C-1 do begin TmpStr:=AFields.DisplayLabel; j:=0; while Pos('|',TmpStr)>0 do begin MyCells[j,i].Text:=Copy(TmpStr,1,Pos('|',TmpStr)-1); MyCells[j,i].Used:=True; if j<>0 then MyCells[j,i].Parent:=@MyCells[i-1,j]; TmpStr:=Copy(TmpStr,Pos('|',TmpStr)+1,Length(TmpStr)); Inc(j); end; MyCells[j,i].Text:=TmpStr; end; end; //合并过程(核心) procedure uniteMyCell; var i :integer; procedure MoveToLastCell(MR,MC:Integer); var i :integer; begin for i:=MR-1 downto 0 do if MyCells[i,MC].Text='' then Continue else begin MyCells[R-1,MC].Text:=MyCells[i,MC].Text; MyCells[i,MC].Text:=''; Break; end; end; procedure CheckLastRow;//检测最后行 var i:Integer; begin for i:=0 to C-1 do if MyCells[R-1,i].Text='' then MoveToLastCell(R-1,i);//移动最后一个有数据的单元格到最后一行 end; //合并当前行 procedure UionCurrRowCell(CR:Integer); var i,SC:integer; function GetNextCUCell(SC:Integer):Integer; var i:Integer; begin Result:=-1; i:=SC+1; while (Result=-1) and (i<C) do begin if not MyCells[CR,i].Used then Inc(i) else if (MyCells[CR,i].Text<>'') then Result:=i; MyCells[CR+1,i].Parent:=@MyCells[CR,i]; Inc(i); end; end; begin SC:=GetNextCUCell(-1);//得到下一个可用单元 if SC=-1 then Exit; //开始比较 i:=SC+1; while (i<c) and (SC<>-1) do begin if MyCells[CR,i].Used then begin if (MyCells[CR,SC].Text=MyCells[CR,i].Text) then begin MyCells[CR,SC].Rect.Right:=i; MyCells[CR,i].Used:=False; MyCells[CR,i].Parent:=@MyCells[CR,SC]; MyCells[CR+1,i].Parent:=@MyCells[CR,SC]; end else SC:=i; end; i:=GetNextCUCell(i); if i=-1 then SC:=-1; end; end; procedure MoveUpCol(MR,MC:Integer); var i :integer; begin for i:=MR to R-1 do if (MyCells[i,MC].Text='') then Continue else begin MyCells[MR,MC].Text:=MyCells[i,MC].Text; MyCells[i,MC].Text:=''; Break; end; end; //检测当前行单元是否为空,为空则将有数据的列上来 procedure CheckCurrRow(CR:Integer); var i :integer; begin for i:=0 to C-1 do begin if (MyCells[CR,i].Used) and (MyCells[CR,i].Text='') then begin MoveUpCol(CR,i); end; end; end; //在范围内查找空行 function FindEmpty(SR:Integer{开始行};FindRect:TRect;var RR:Integer):Boolean; var i,j :integer; Same:Boolean; begin Result:=False; for i:=SR to R-1 do begin Same:=True; for j:=FindRect.Left to FindRect.Right do if MyCells[i,j].Used and (MyCells[i,j].Text='') then Continue else begin Same:=False; Break; end; if Same then begin RR:=i; Result:=True; Break; end; end; end; //当前行与上一行交换 procedure ChangeCell(CRect:TRect;RR:Integer); var i :integer; begin for i:= CRect.Left to CRect.Right do begin MyCells[RR,i].Text:=MyCells[RR-1,i].Text; MyCells[RR-1,i].Text:=''; end; end; //提升空行 procedure DoUpCol(CR,CC:Integer); var i,RR:integer; begin for i:=CR+2 to R-2 do //在范围内查找空行,并交换行 if FindEmpty(i,MyCells[CR,CC].Rect,RR) then ChangeCell(MyCells[CR,CC].Rect,RR); end; //合并列 procedure DoUionCell(CR,CC:Integer); var i,RR,j:Integer; begin for i:=CR+1 to R-1 do begin if FindEmpty(i,MyCells[CR,CC].Rect,RR) then begin if RR>CR then begin MyCells[CR,CC].Rect.Bottom:=RR; for j:=MyCells[CR,CC].Rect.Left to MyCells[CR,CC].Rect.Right do begin MyCells[RR,j].Used:=False; MyCells[RR,j].Parent:=@MyCells[CR,CC]; end; end else Break; end else Break; end; end; //向下合并列 procedure UionCurrRowColCell(CR :integer); var i:integer; begin for i:=0 to C-1 do begin if MyCells[CR,i].Used then DoUpCol(CR,i);//提升空行 end; for i:=0 to C-1 do begin if MyCells[CR,i].Used then DoUionCell(CR,i);//合并列 end; end; begin CheckLastRow; //检测最后行 for i:=0 to R-2 do //最后一行不管 begin UionCurrRowCell(i); //合并当前行 CheckCurrRow(i); //检测当前行单元是否为空,为空则将有数据的列上来 UionCurrRowColCell(i); //向下合并列 end; end;begin R:=GetMaxTitleRow(AField); C:=AField.Count; GetFieldToMycells(AField); uniteMyCell; end;end.

太感谢了 拿分

接受答案了.

帅哥 不得不在麻烦你下，的确可以了，能够创建出excle 但是excel里的数据一个也没有啊，

用这个吧，我刚修改好的procedure TForm1.Button3Click(Sender: TObject);var ExcelApplication1:TExcelApplication; ExcelWorksheet1:TExcelWorksheet; ExcelWorkbook1:TExcelWorkbook; i,j:integer; begin try ExcelApplication1:=TExcelApplication.Create(Application); ExcelWorksheet1:=TExcelWorksheet.Create(Application); ExcelWorkbook1:=TExcelWorkbook.Create(Application); ExcelApplication1.Connect; ExcelApplication1.Visible[0]:=True; except Application.Messagebox('Excel没有安装!','Hello',MB_ICONERROR+mb_Ok); Abort; end; try ExcelApplication1.Workbooks.Add(EmptyParam,0); ExcelWorkbook1.ConnectTo(ExcelApplication1.Workbooks[1]); ExcelWorksheet1.ConnectTo(ExcelWorkbook1.Worksheets[1]as _worksheet); DBGridEh1.DataSource.DataSet.First; for j:=0 to DBGridEh1.DataSource.DataSet.Fields.Count-2 do begin ExcelWorksheet1.Cells.item[3,j+1]:=DBGridEh1.Columns[j].Title.Caption;//导出DBGridEh1中显示的字段标题 //ExcelWorksheet1.Cells.item[3,j+1]:=DBGridEh1.DataSource.DataSet.Fields[j].DisplayLabel;//导出数据库中字段名 ExcelWorksheet1.Cells.item[3,j+1].font.size:='10'; end; for i:=4 to DBGridEh1.DataSource.DataSet.RecordCount + 3 do //从excel的第4行到最后 begin for j:= 1 to DBGridEh1.DataSource.DataSet.Fields.Count - 1 do //从DBGridEh1的第1列到最后 begin //ExcelWorksheet1.Cells.item[i,j+1]:=DBGridEh1.DataSource.DataSet.Fields[j].Asstring; //ExcelWorksheet1.Cells.item[i,j+1].font.size:='10';**************************************** ExcelWorksheet1.Range[ExcelWorksheet1.Cells.item[1,2], ExcelWorksheet1.Cells.item[i,2]].NumberFormatLocal:='@';//第二列设为文本格式**************************************** ExcelWorksheet1.Cells.item[i,j]:=DBGridEh1.DataSource.DataSet.Fields[j].Asstring; ExcelWorksheet1.Cells.item[i,j].font.size:='10'; end; DBGridEh1.DataSource.DataSet.Next; end; ExcelWorksheet1.Columns.AutoFit; ExcelWorksheet1.Cells.item[1,2]:='预测表'+Formatdatetime('YYYYmmdd',Now);//DBGridEh1.Columns[0].FieldName; //在excel中第一行显示标题，产品物料明晰表 ExcelWorksheet1.Cells.Item[1,2].font.size:='14'; finally ExcelWorkSheet1.Disconnect; ExcelWorkBook1.Disconnect; ExcelApplication1.Disconnect; end;end;