TDBGrid 数据导入到execle

procedure TFxxlook.savetoexcel(dbname:TDBGrid);

var

  excelapp:Variant;

  page:Variant;

  i,j:In
4000
teger;

  savedialog:TSaveDialog;

  BM:TBookmark;

  strsavefile:string;

 

begin

   if dbname.DataSource.DataSet.IsEmpty then //判断TDBGRID是否有数据

      begin

        MessageBox(Application.Handle,'数据为空不能进行保存','警告',MB_OK);

        Abort;

        Exit;

      end;

   savedialog:=TSaveDialog.Create(nil); // 创建一个保存对话框

   savedialog.Filter:='*.xls|*.XLS';    //设置保存文件的后缀

   savedialog.Execute;                  //打开保存对话框

   strsavefile:=savedialog.FileName;    //保存文件的目录

 

   if Length(strsavefile)=0 then Exit;  //目录为空则退出程序

 

   try

     Screen.Cursor:=crhourglass; //屏幕指针形状

     try

       excelapp:=CreateOleObject('excel.application');

       excelapp.workbooks.add(-4167); //设置添加数据的大小

       excelapp.workbooks[1].worksheets[1].name:='数据库数据';//标签页名称

       page:=excelapp.workbooks[1].worksheets['数据库数据'];  //指定标签页

       j:=1;

     except

       MessageBox(GetActiveWindow,'请确认是否安装了EXCEL','提示',MB_OK+ MB_ICONINFORMATION);

       Exit;

     end;

     with dbname.DataSource.DataSet do

     begin

       BM:=GetBookmark;

       DisableControls;

 

       //将DBGRID中的标题插入到EXCEL表中首行

       for i:=0 to dbname.Columns.Count-1 do

       begin

         if dbname.Columns[1].Visible=False then

         Continue;

 

         page.cells[j,i+1]:=dbname.Columns[i].Title.Caption;

         page.cells[j,i+1].font.bold:=True;

       end;

       Inc(j);  //ECXEL表中的下一行

       First;

       while not Eof do

       begin

         for i:=0 to dbname.Columns.Count-1 do

         begin

           if dbname.Columns[i].Visible=False then

           Continue;

 

           //将指定行添加到EXCEL表中

           page.cells[j,i+1]:=Trim(dbname.DataSource.DataSet.fieldbyname

           (dbname.Columns[i].FieldName).AsString);

         end;

         Inc(j);   //EXCEL表中下一行

         Next;     //TDBGrid表中下一行

       end;

       GotoBookmark(BM);

       FreeBookmark(BM);

       EnableControls;

     end;

     excelapp.activeworkbook.saveas(strsavefile);  //将EXCEL表保存到指定目录下

     Application.ProcessMessages;

     excelapp.application.quit;

   finally

     savedialog.Free;

     Screen.Cursor:=crDefault;

   end;

end;