如何把DBgrid的数据导出为excel文档？

Question

rt

Answer 1

procedure 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'];
       // XLApp.Workbooks.Options.CheckSpellingAsYouType:= False;
       // XLApp.Workbooks.Options.CheckGrammarAsYouType:= False;
    except
        showmessage('你的电脑没有安装excel程序，无法完成此功能!');
        exit;
    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;

Answer 2

procedure TForm1.ToolButton4Click(Sender: TObject);
var
ExcelApp : Variant; //声明ExcelApp为Variant
RecordCounts : Integer;
i:Integer;
PRODUCT:STRING;
begin
if pagecontrol1.ActivePageIndex=0 then
  begin
        try
          ExcelApp := CreateOleObject('Excel.Application'); //创建Excel.Application
        except
          ShowMessage('本机没有安装EXCEL！');
          exit;
        end;
        IF yes=0 THEN
           BEGIN
           SHOWMESSAGE('无资料可转换!');
           EXIT;
           END;
        Animate2.Active:=TRUE;
        Animate2.Visible := True;
        RecordCounts := DBGRID3.DataSource.DataSet.RecordCount ; //取QUERY1的记录数用于循环
        ExcelApp.WorkBooks.Add;//新加一个工作簿
        ExcelApp.WorkSheets[1].Activate; //激活第一个Sheet
        //Query1.Close;
        //Query1.Open;
        ADOpr1.First;;
        ExcelApp.Cells[1,1].value :='阶次序号';
        ExcelApp.Cells[1,2].value :='品号';
        ExcelApp.Cells[1,3].value :='品名';
        ExcelApp.Cells[1,4].value :='规格';
        ExcelApp.Cells[1,5].value :='品号属性';
        ExcelApp.Cells[1,6].value :='单位';
        ExcelApp.Cells[1,7].value :='标准批量';
        ExcelApp.Cells[1,8].value :='组成用量';
        ExcelApp.Cells[1,9].value :='底数';
        EXCELAPP.WORKSHEETS[1].COLUMNS['A'].COLUMNWIDTH :=8;
        EXCELAPP.WORKSHEETS[1].COLUMNS['B'].COLUMNWIDTH :=14.5;
        EXCELAPP.WORKSHEETS[1].COLUMNS['C'].COLUMNWIDTH :=33.25;
        EXCELAPP.WORKSHEETS[1].COLUMNS['D'].COLUMNWIDTH :=33.25;
        EXCELAPP.WORKSHEETS[1].COLUMNS['E'].COLUMNWIDTH :=8.38;
        EXCELAPP.WORKSHEETS[1].COLUMNS['F'].COLUMNWIDTH :=5.25;
        EXCELAPP.WORKSHEETS[1].COLUMNS['G'].COLUMNWIDTH :=8.25;
        EXCELAPP.WORKSHEETS[1].COLUMNS['H'].COLUMNWIDTH :=8.25;
        EXCELAPP.WORKSHEETS[1].COLUMNS['I'].COLUMNWIDTH :=4.88;
        for i:=2 to RecordCounts+1 do
        begin
          if not DBGRID3.DataSource.DataSet.Eof then
          begin
            ExcelApp.Cells[i,1].Value :=DBGRID3.DataSource.DataSet.FieldByName('NO').AsString;
            ExcelApp.Cells[i,2].Value :=DBGRID3.DataSource.DataSet.FieldByName('B001').AsString;
            ExcelApp.Cells[i,3].Value :=DBGRID3.DataSource.DataSet.FieldByName('B003').AsString;
            ExcelApp.Cells[i,4].Value :=DBGRID3.DataSource.DataSet.FieldByName('B004').AsString;
            ExcelApp.Cells[i,5].Value :=DBGRID3.DataSource.DataSet.FieldByName('B002').AsString;
            ExcelApp.Cells[i,6].Value :=DBGRID3.DataSource.DataSet.FieldByName('B005').AsString;
            ExcelApp.Cells[i,7].Value :=DBGRID3.DataSource.DataSet.FieldByName('B006').AsFloat;
            ExcelApp.Cells[i,8].Value :=DBGRID3.DataSource.DataSet.FieldByName('B007').AsFloat;
            ExcelApp.Cells[i,9].Value :=DBGRID3.DataSource.DataSet.FieldByName('B008').AsFloat;
            DBGRID3.DataSource.DataSet.Next;
          end;
        end;
        Animate2.Active := False;
        Animate2.VISIBLE:=FALSE;
        PRODUCT:=TRIM(DBGRID3.DataSource.DataSet.FieldByName('B01').AsString);
        IF FILEEXISTS('c:\'+PRODUCT+'.xls') THEN
            if messageDLG('文件 c:\'+PRODUCT+'.xls 已存在,是否覆盖?',mtConfirmation,[mbYes,mbNo,mbCancel],0)<> mrYes then
            EXIT
            ELSE
            BEGIN
            DELETEFILE('c:\'+PRODUCT+'.xls');
            END;
        ExcelApp.ActiveWorkBook.SaveAs('c:\'+PRODUCT+'.xls');
        if MessageDlg('文件 c:\'+PRODUCT+'.xls 保存成功，是否要打开编辑此文件？',mtConfirmation,[mbYes,mbNo,mbCancel],0)= mrYes then
          ExcelApp.Visible := True //设置EXCEL窗口为可见
        else
        begin
          ExcelApp.Visible := False;
          ExcelApp.Quit;
        end;
  end
else
  begin
      TRY
      EXCELAPP:=CREATEOLEOBJECT('EXCEL.APPLICATION');
      EXCEPT
      SHOWMESSAGE('本机没有安装EXCEL');
      EXIT;
      END;
      IF YES2=0 THEN
         begin
          SHOWMESSAGE('无资料可转换!');
          EXIT;
         END;
      Animate2.Active:=TRUE;
      Animate2.Visible := True;
      RECORDCOUNTS:=DBGRID6.DataSource.DataSet.RecordCount;
      EXCELAPP.WORKBOOKS.ADD;
      EXCELAPP.WORKSHEETS[1].ACTIVATE;
      ADOpr2.First;
      EXCELAPP.CELLS[1,1]:='阶次序号';
      EXCELAPP.CELLS[1,2]:='品号';
      EXCELAPP.CELLS[1,3]:='品号属性';
      EXCELAPP.CELLS[1,4]:='品名';
      EXCELAPP.CELLS[1,5]:='规格';
      EXCELAPP.CELLS[1,6]:='单位';
     { EXCELAPP.CELLS[1,7]:='标准批量';
      EXCELAPP.CELLS[1,8]:='组成用量';
      EXCELAPP.CELLS[1,9]:='底数';}
      EXCELAPP.CELLS[1,7]:='单价';
      EXCELAPP.CELLS[1,8]:='用量';
      EXCELAPP.CELLS[1,9]:='成本';
      EXCELAPP.WORKSHEETS[1].COLUMNS['A'].COLUMNWIDTH :=8;
      EXCELAPP.WORKSHEETS[1].COLUMNS['B'].COLUMNWIDTH :=14.5;
      EXCELAPP.WORKSHEETS[1].COLUMNS['C'].COLUMNWIDTH :=33.25;
      EXCELAPP.WORKSHEETS[1].COLUMNS['D'].COLUMNWIDTH :=33.25;
      EXCELAPP.WORKSHEETS[1].COLUMNS['E'].COLUMNWIDTH :=8.38;
      EXCELAPP.WORKSHEETS[1].COLUMNS['F'].COLUMNWIDTH :=5.25;
     { EXCELAPP.WORKSHEETS[1].COLUMNS['G'].COLUMNWIDTH :=8.25;
      EXCELAPP.WORKSHEETS[1].COLUMNS['H'].COLUMNWIDTH :=8.25;
      EXCELAPP.WORKSHEETS[1].COLUMNS['I'].COLUMNWIDTH :=4.88;}
      EXCELAPP.WORKSHEETS[1].COLUMNS['G'].COLUMNWIDTH :=6;
      EXCELAPP.WORKSHEETS[1].COLUMNS['H'].COLUMNWIDTH :=12;
      EXCELAPP.WORKSHEETS[1].COLUMNS['I'].COLUMNWIDTH :=8;
      FOR I:=2 TO RECORDCOUNTS+1 DO
      BEGIN
         IF NOT DBGRID6.DataSource.DataSet.Eof THEN
            BEGIN
            ExcelApp.Cells[i,1].Value :=DBGRID6.DataSource.DataSet.FieldByName('NO').AsString;
            ExcelApp.Cells[i,2].Value :=DBGRID6.DataSource.DataSet.FieldByName('B001').AsString;
            ExcelApp.Cells[i,3].Value :=DBGRID6.DataSource.DataSet.FieldByName('B003').AsString;
            ExcelApp.Cells[i,4].Value :=DBGRID6.DataSource.DataSet.FieldByName('B004').AsString;
            ExcelApp.Cells[i,5].Value :=DBGRID6.DataSource.DataSet.FieldByName('B002').AsString;
            ExcelApp.Cells[i,6].Value :=DBGRID6.DataSource.DataSet.FieldByName('B005').AsString;
            {ExcelApp.Cells[i,7].Value :=DBGRID6.DataSource.DataSet.FieldByName('B006').AsFloat;
            ExcelApp.Cells[i,8].Value :=DBGRID6.DataSource.DataSet.FieldByName('B007').AsFloat;
            ExcelApp.Cells[i,9].Value :=DBGRID6.DataSource.DataSet.FieldByName('B008').AsFloat;}
            ExcelApp.Cells[i,7].Value :=DBGRID6.DataSource.DataSet.FieldByName('B010').AsFloat;
            ExcelApp.Cells[i,8].Value :=DBGRID6.DataSource.DataSet.FieldByName('B013').AsFloat;
            ExcelApp.Cells[i,9].Value :=DBGRID6.DataSource.DataSet.FieldByName('B012').AsFloat;
            DBGRID6.DataSource.DataSet.Next;
            END;
     END;
     Animate2.Active := False;
     Animate2.VISIBLE:=FALSE;
     PRODUCT:='成本'+TRIM(DBGRID6.DataSource.DataSet.FieldByName('B01').AsString);
     IF FILEEXISTS('c:\'+PRODUCT+'.xls') THEN
          if messageDLG('文件 c:\'+PRODUCT+'.xls 已存在,是否覆盖?',mtConfirmation,[mbYes,mbNo,mbCancel],0)<> mrYes then
          EXIT
          ELSE
          BEGIN
          DELETEFILE('c:\'+PRODUCT+'.xls');
          END;
     ExcelApp.ActiveWorkBook.SaveAs('c:\'+PRODUCT+'.xls');
     if MessageDlg('文件 c:\'+PRODUCT+'.xls 保存成功，是否要打开编辑此文件？',mtConfirmation,[mbYes,mbNo,mbCancel],0)= mrYes then
        ExcelApp.Visible := True //设置EXCEL窗口为可见
      else
      begin
        ExcelApp.Visible := False;
        ExcelApp.Quit;
      end;
  end;
end;

Answer 3

以上是我程序中的一段代码，转出EXCEL的按钮只有一个，根据页框不同，转不同的资料

Answer 4

导出为excel表：
procedure TForm3.Excel4Click(Sender: TObject);   //将联合查询的结构转为excel表
var xlsFilename :string;
    eclApp,WorkBook :variant ;
    a_filedNo,i,j :integer;
begin
  a_filedNo := Form3.DBGrid4.FieldCount;
  xlsFileName :='成绩基本信息.xls';  try
    eclApp :=CreateOleObject('Excel.Application');
    WorkBook :=CreateOleObject('Excel.Sheet');
  except
    showmessage('您的系统没有安装MS EXCEL');
    exit;
  end;  try
    WorkBook :=eclApp.workBooks.add ;
    for i :=1 to  a_FiledNo do      //转化字段名；
    begin
      //eclApp.cells(1,i) :=Form3.DBGrid4.Columns[i-1].Title.caption ;
      eclApp.cells(1,i) :=Form3.DBGrid4.Fields[i-1].FieldName ;
    end;    Form3.DBGrid4.DataSource.DataSet.First ;
    for i :=1 to  Form3.a_recno   do    //Form3.a_recno
    begin
      for j :=1 to  a_filedNo do  //转化一个记录
        eclApp.cells(i+1,j) :=Form3.DbGrid4.Fields[j-1].Value ;
      Form3.DBGrid4.DataSource.DataSet.Next ;
    end;
    try
      WorkBook.saveas(ExtractFilePath(Application.ExeName )+xlsFileName);
      WorkBook.close;
      showmessage('保存EXECL文件成功，路径为：'+ExtractFilePath(Application.ExeName )+xlsFileName);
    except
      showmessage('保存文件出错');
    end;
  except
    showmessage('不能正确操作EXECL文件，可能该文件已经被其他程序占用或系统错误');
    WorkBook.close;
    eclApp.quit;
    eclApp :=Unassigned;
  end;
end;

Answer 5

wdsimon(渴望成为高手▲▲▲▲▲) 
的太长了
我只要简单的，从dbgrid->excel