如何将DBGrid中的数据直接导出到Excel表中

Question

请问如何将DBGrid中的数据直接导出到Excel表中?求代码.

Answer 1

/////////////////////////////////////////////
利用剪贴板，速度很快！适合装有Excel的机器
USES Clipbrd,ComObj;procedure TForm1.Button1Click(Sender: TObject);
var
  str:string;
  i:Integer;
  excelapp,sheet:Variant;
begin
//  lbl2.Caption:=DateTimeToStr(Now);
  str:='';
  dbgrd1.DataSource.DataSet.DisableControls;
  for i:=0 to dbgrd1.DataSource.DataSet.FieldCount-1 do
   str:=str+dbgrd1.DataSource.DataSet.fields[i].DisplayLabel+char(9);
  str:=str+#13;
  dbgrd1.DataSource.DataSet.First;
  while not(dbgrd1.DataSource.DataSet.eof) do begin
    for i:=0  to dbgrd1.DataSource.DataSet.FieldCount-1 do
     str:=str+dbgrd1.DataSource.DataSet.Fields[i].AsString+char(9);
    str:=str+#13;
    dbgrd1.DataSource.DataSet.next;    lbl1.Caption:=IntToStr(dbgrd1.DataSource.DataSet.RecNo);
    Application.ProcessMessages;
  
   end;//end while   dbgrd1.DataSource.DataSet.EnableControls;   clipboard.Clear;
   Clipboard.Open;
   Clipboard.AsText:=str;
   Clipboard.Close;
   excelapp:=createoleobject('excel.application');
   excelapp.workbooks.add(1); // excelapp.workbooks.add(-4167);
   sheet:=excelapp.workbooks[1].worksheets[1];
   sheet.name:='sheet1';
   sheet.paste;
   Clipboard.Clear;
//   sheet.columns.font.Name:='宋体';
//   sheet.columns.font.size:=9;
//   sheet.Columns.AutoFit;
   excelapp.visible:=true;
//   lbl3.Caption:=DateTimeToStr(Now);end;/////////////////////////////////////////////

Answer 2

////////////////////////////////////////////////
利用TStringList，速度很快！适合没有装Excel的机器
procedure TForm1.Button1Click(Sender: TObject);
var
  s:TStringList;
  str:string;
  i:Integer;
begin
//  lbl1.Caption:=DateTimeToStr(Now);
  str:='';
  dbgrd1.DataSource.DataSet.DisableControls;
  for i:=0 to dbgrd1.DataSource.DataSet.FieldCount-1 do
    str:=str+dbgrd1.DataSource.DataSet.fields[i].DisplayLabel+char(9);
  str:=str+#13;
  dbgrd1.DataSource.DataSet.First;
  while not(dbgrd1.DataSource.DataSet.eof) do begin
    for i:=0  to dbgrd1.DataSource.DataSet.FieldCount-1 do
      str:=str+dbgrd1.DataSource.DataSet.Fields[i].AsString+char(9);      str:=str+#13;
      dbgrd1.DataSource.DataSet.next;//    lbl3.Caption:=IntToStr(dbgrd1.DataSource.DataSet.RecNo);
//    Application.ProcessMessages;   end;//end while   dbgrd1.DataSource.DataSet.EnableControls;
   s:=TStringList.Create;
   s.Add(str);
   s.SaveToFile('c:\temp.xls');//保存到c:\temp.xls
   s.Free;
//   lbl2.Caption:=DateTimeToStr(Now);end;
////////////////////////////////////////////////

Answer 3

/////////////实现函数
procedure Tfmbaojiacbview.DbgridSaveToExcel(dbgrid:TDBgrid);
var
    XlAPP:Variant;
    Sheet1:Variant;
    i,j:integer;
    curRow:integer;begin
    if dbgrid.DataSource.DataSet.RecordCount<1 then exit;
    //?建excel?象
    try
        XlApp:=createoleobject('Excel.Application');
        XLApp.Visible:=false;
        XLApp.Workbooks.Add(xlWBatWorkSheet);
        Sheet1 := XLApp.Workbooks[1].WorkSheets['sheet1'];          Sheet1.Columns[1].NumberFormat:='@'; //////////設計某列為文本類型
          Sheet1.Columns[2].NumberFormat:='@';
          Sheet1.Columns[3].NumberFormat:='@';
          Sheet1.Columns[4].NumberFormat:='@';
          Sheet1.Columns[13].NumberFormat:='@';
          Sheet1.Columns[14].NumberFormat:='@';
       // XLApp.Workbooks.Options.CheckSpellingAsYouType:= False;
       // XLApp.Workbooks.Options.CheckGrammarAsYouType:= False;
    except
    on e:exception do
    begin       showmessage('excel程序出錯，無法完成此功能!');
        exit;
        end;
    end;    curRow:=0;
    for j:=0 to dbgrid.FieldCount-1 do
    begin        sheet1.cells[1,curRow+1]:=dbgrid.Columns[j].Title.Caption;
        inc(curRow);
    end;
    //?理??    dbgrid.DataSource.DataSet.First;
    i:=2;
    while not dbgrid.DataSource.DataSet.Eof do
    begin
       //?理一行
       curRow:=0;
       for j:=0 to dbgrid.Columns.Count-1 do
       begin             Sheet1.cells[i,curRow+1]:=TRim(dbgrid.Fields[j].DisplayText) ;
            inc(curRow);
       end;
       i:=i+1;
       dbgrid.DataSource.DataSet.Next;
    end;
    XLApp.Visible:=true;
end;
调用：
procedure Tfmbaojiacbview.BitBtn3Click(Sender: TObject);
begin
 DbgridSaveToExcel(DBgrid1);
end;

Answer 4

别忘记USES ComObj;
uses ComObj;
.....
procedure TForm1.DBGrid1DblClick(Sender: TObject);
var
  myexcel:variant;
  workbook:olevariant;
  worksheet:olevariant;
  i,j,k:integer;
begin
 try
   myexcel:=createoleobject('excel.application');
   myexcel.application.workbooks.add;
   myexcel.caption:='将数据导入到EXCEL表中';
   myexcel.application.visible:=true;
   workbook:=myexcel.application.workbooks[1];
   worksheet:=workbook.worksheets.item[1];
   except
    showmessage('EXCEL不存在！');
   end;
   i:=0;
   table1.first;
  //加表头
  for k:=0 to table1.FieldCount-1 do
    worksheet.cells[1,1+k]:=table1.fields[k].DisplayName;  //加数据
  while not table1.eof do
   begin
     inc(i);
     for j:=0 to table1.fieldcount-2 do
       worksheet.cells[i+1,j+1]:=table1.fields[j].asstring;
     table1.next;
   end;end;  

Answer 5

var
  i:integer;
  strtitle:string;
begin
    if  (frmDm.aqWarnResult.Active=false) or (frmDm.aqWarnResult.RecordCount=0) or (frmDm.aqWarnResult.FieldByName('id').AsString='') then
    begin
     showmessage('没有数据可导出！');
     exit;  //没有选择
    end;
    try
        excelAppRp.Connect ;
        excelAppRp.Visible[0]:=True;
        excelWbRp.ConnectTo(excelApprp.Workbooks.Add(1,0));
   except
        showmessage('打开Excel失败，可能Excel没有安装!');
        abort;
   end;    with excelWSheetRp do
    begin
        ConnectTo(excelWbRp.Worksheets.Item [1] as _WorkSheet);
        Activate;
        with Cells do           begin
             excelWSheetRp.Range['A1','E1'].Merge(true);       //将大标题行合并
             excelWSheetRp.Range['A1','E1'].HorizontalAlignment :=xlCenter;    //大标题行居中
             excelWSheetRp.Range['A1','A1'].Font.Name :='宋体';
             excelWSheetRp.Range['A1','A1'].Font.Size :=14;
             excelWSheetRp.Range['A1','A1'].Font.Bold:=true;
             Item[1,1]:='预警结果';    //写标题
             excelWSheetRp.Range['A2','E2'].Merge(true);       //将填报单位行合并
             strtitle:='预警对象：'+'  '+frmDm.aqMarkNeed.fieldbyname('cropName').asstring;
             Item[2,1]:=strtitle;
             Item[3,1]:='预警等级';
             Item[3,2]:='时间极小值';
             Item[3,3]:='时间极大值';
             Item[3,4]:='预警结果';
             Item[3,5]:='预警描述';  
             for i:=0 to (frmDm.aqWarnResult.RecordCount-1) do    //写内容
             begin
                 Item[i+4,1]:=frmDm.aqWarnResult.fieldbyname('varlevel').AsString;
                 Item[i+4,2]:=frmDm.aqWarnResult.fieldbyname('dtstartdate').AsString;
                 Item[i+4,3]:=frmDm.aqWarnResult.fieldbyname('dtenddate').AsString;
                 Item[i+4,4]:=frmDm.aqWarnResult.fieldbyname('dewarnresult').AsString;
                 Item[i+4,5]:=frmDm.aqWarnResult.fieldbyname('varnote').AsString;  
                 frmDm.aqWarnResult.Next;
             end; 
             excelWSheetRp.Range['E1','C1'].Font.Name :='宋体';
             excelWSheetRp.Range['E1','C1'].Font.Size :=14;
             excelWSheetRp.Range['E1','C1'].Font.Bold:=true;     
             //加外部边框
             excelWSheetRp.Range['A3','A'+IntToStr(i+3)].Borders[xlEdgeLeft].LineStyle := xlContinuous;
             excelWSheetRp.Range['A3','E3'].Borders[xlEdgeTop].LineStyle := xlContinuous;
             excelWSheetRp.Range['A'+IntToStr(i+3),'E'+IntToStr(i+3)].Borders[xlEdgeBottom].LineStyle := xlContinuous;
             excelWSheetRp.Range['E3','E'+IntToStr(i+3)].Borders[xlEdgeRight].LineStyle := xlContinuous;
            //加内部边框
             excelWSheetRp.Range['A'+IntToStr(i+3),'E3'].Borders[xlInsideVertical].LineStyle := xlContinuous;
             excelWSheetRp.Range['A'+IntToStr(i+3),'E3'].Borders[xlInsideHorizontal].LineStyle := xlContinuous;
             excelWSheetRp.Columns.EntireColumn.AutoFit;     //自适应列宽    
           end;
        end;
end;

Answer 6

XLApp.Workbooks.Add(xlWBatWorkSheet);
这个语句对吗
为什么 我的总提示
[Error] jfcx.pas(459): Undeclared identifier: 'xlwbatWorkSheet'
该怎么解决

Answer 7

to:gxgyj(Jackson...) 
刚才偶试了一下,好像不行。请教！！

Answer 8

procedure Tform1.DataToExcel(aPath: string);
var
  MySQL,connStr: string;
begin
  ConnStr := 'Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=excel 8.0;Data Source='''+aPath+''';Persist Security Info=False';
  MySQL := 'select *  into [sheet1] from book3 in [ODBC]'+ '[ODBC;driver=SQL Server;UID=;server='+127.0.0.1+';database='databaseName';]';
  try
    adoconnection1.connected := false;
    adoconnection1.connectionstring := ConnStr;
    adoconnection1.connected := true;
    adoconnection1.execute(MySQL);
    application.messagebox('Educed successfully','information!',mb_ok+mb_iconinformation);
    adoconnection1.connected := false;
  except
    application.messagebox('Educed failed!','Errors!',mb_ok+mb_iconStop);
    adoconnection1.connected := false;
  end;end;试一下这个，前面的语句是连接数据库用的，我用的是sql server2000。当然别的也是可以的，改一下就行了吧

Answer 9

请参考这个:一个导出Excel非常快的类
http://7622.com/list/56973.htm