您好,欢迎来到[编程问答]网站首页   源码下载   电子书籍   软件下载   专题
当前位置:首页 >> 编程问答 >> Delphi >> 求快速将DBGrid导出到EXCEL表格的方法?

求快速将DBGrid导出到EXCEL表格的方法?

来源:网络整理     时间:2016/7/5 14:48:40     关键词:

关于网友提出的“ 求快速将DBGrid导出到EXCEL表格的方法?”问题疑问,本网通过在网上对“ 求快速将DBGrid导出到EXCEL表格的方法?”有关的相关答案进行了整理,供用户进行参考,详细问题解答如下:

问题: 求快速将DBGrid导出到EXCEL表格的方法?
描述:

用delphi+SQL2000编程,用ADOQuery读数据库,
现在是用OLE控制EXCEL一条一条读数据到EXCEL,感觉好慢,
有什么快速的导出方法吗???


解决方案1:


function    ProgressBarform(max:integer):tProgressBar;   
   var   
       ProgressBar1:tProgressBar;   
       form:tform;   
   begin   
       application.CreateForm(tform,form);   
       form.Position:=poScreenCenter;   
       form.BorderStyle:=bsnone;   
       form.Height:=30;   
       form.Width:=260;   
       ProgressBar1:=tProgressBar.Create(form);   
       ProgressBar1.Smooth:=true;   
       ProgressBar1.Max:=max;   
       ProgressBar1.Parent:=form;   
       ProgressBar1.Height:=20;   
       ProgressBar1.Width:=250;   
       ProgressBar1.Left:=5;   
       ProgressBar1.Top:=5;   
       ProgressBar1.Step:=1;   
       form.Show;   
       result:=ProgressBar1;   
   end;   
   function    ExportToExcel(dbgrid:tdbgrid):boolean;
   const   
       xlNormal=-4143;   
   var   
       i,j,k:integer;   
       str,filename:string;   
       excel:OleVariant;   
       SavePlace:    TBookmark;   
       savedialog:tsavedialog;   
       ProgressBar1:TProgressBar;   
   begin   
       result:=false;   
       filename:='';   
       if    dbgrid.DataSource.DataSet.RecordCount>65536    then   
             begin   
                 if    application.messagebox('需要导出的数据过大,Excel最大只能容纳65536行,是否还要继续?','询问 ',mb_yesno+mb_iconquestion)=idno    then   
                       exit;   
             end;   
       screen.Cursor:=crHourGlass;   
       try   
           excel:=CreateOleObject('Excel.Application');   
           excel.workbooks.add;   
       except   
             screen.cursor:=crDefault;   
           showmessage('无法调用Excel!');   
           exit;   
       end;   
       savedialog:=tsavedialog.Create(nil);   
       savedialog.Filter:='Excel文件(*.xls)|*.xls';   
       if    savedialog.Execute    then   
             begin   
                 if    FileExists(savedialog.FileName)    then   
                       try   
                           if    application.messagebox('该文件已经存在,要覆盖吗?','询问',mb_yesno+mb_iconquestion)=idyes    then   
                                 DeleteFile(PChar(savedialog.FileName))   
                           else   
                                 begin   
                                     Excel.Quit;   
                                     savedialog.free;   
                                       screen.cursor:=crDefault;   
                                     Exit;   
                                 end;   
                       except   
                           Excel.Quit;   
                           savedialog.free;   
                             screen.cursor:=crDefault;   
                           Exit;   
                       end;   
                 filename:=savedialog.FileName;   
             end;   
       savedialog.free;   
       if    filename=''    then   
             begin   
                 result:=true;   
                 Excel.Quit;   
                 screen.cursor:=crDefault;   
                 exit;   
             end;   
       k:=0;   
       for    i:=0    to    dbgrid.Columns.count-1    do   
           begin   
               if    dbgrid.Columns.Items[i].Visible    then   
                     begin   
                         //Excel.Columns[k+1].ColumnWidth:=dbgrid.Columns.Items[i].Title.Column.Width;   
                         excel.cells[1,k+1]:=dbgrid.Columns.Items[i].Title.Caption;   
                         inc(k);   
                     end;   
           end;   
    
       dbgrid.DataSource.DataSet.DisableControls;   
       saveplace:=dbgrid.DataSource.DataSet.GetBookmark;   
       dbgrid.DataSource.dataset.First;   
       i:=2;   
       if    dbgrid.DataSource.DataSet.recordcount>65536    then   
             ProgressBar1:=ProgressBarform(65536)   
       else   
             ProgressBar1:=ProgressBarform(dbgrid.DataSource.DataSet.recordcount);   
       while    not    dbgrid.DataSource.dataset.Eof    do   
           begin   
               k:=0;   
               for    j:=0    to    dbgrid.Columns.count-1    do   
                   begin   
                       if    dbgrid.Columns.Items[j].Visible    then   
                             begin   
                                 excel.cells[i,k+1].NumberFormat:='@';   
                                 if    not    dbgrid.DataSource.dataset.fieldbyname(dbgrid.Columns.Items[j].FieldName).isnull    then   
                                       begin   
                                           str:=dbgrid.DataSource.dataset.fieldbyname(dbgrid.Columns.Items[j].FieldName).value;   
                                           Excel.Cells[i,    k    +    1]    :=    Str;   
                                       end;   
                                 inc(k);   
                             end   
                       else   
                             continue;   
                   end;   
               if    i=65536    then   
                     break;   
               inc(i);   
               ProgressBar1.StepBy(1);   
               dbgrid.DataSource.dataset.next;   
           end;   
       progressbar1.Parent.Free;   
    
       dbgrid.DataSource.dataset.GotoBookmark(SavePlace);   
       dbgrid.DataSource.dataset.EnableControls;   
    
       try   
           if    copy(FileName,length(FileName)-3,4)<>'.xls'    then   
                 FileName:=FileName+'.xls';   
           Excel.ActiveWorkbook.SaveAs(FileName,    xlNormal,    '',    '',    False,    False);   
       except   
           Excel.Quit;   
             screen.cursor:=crDefault;   
           exit;   
       end;   
       Excel.Visible    :=    true;   
       screen.cursor:=crDefault;   
       Result    :=    true;   
   end;

以上介绍了“ 求快速将DBGrid导出到EXCEL表格的方法?”的问题解答,希望对有需要的网友有所帮助。
本文网址链接:http://www.codes51.com/itwd/2300679.html

相关图片

相关文章