捐赠 | 广告 | 注册 | 发布 | 上传 | 关于我们    
  粤ICP备10103342号-1 DELPHI盒子 | 盒子文章 | 盒子问答悬赏 | 最新更新 | 盒子检索 | 下载中心 | 高级搜索    
  精品专区 | 繁體中文 | 奖励公告栏 | 直通车账号登陆 | 关闭GOOGLE广告 | 临时留言    
 
广告
评论：DBGrid分页(Sheet)导出到Excel (支持超过65536条记录)
iamdream 24171 2006/6/9 0:04:37
to idoudo:
注意 varCells  := VarArrayCreate 这个才是快的原因！我的EMail: iamdream@yeah.net

to dodge:
不知你是怎么调用的？出什么错？
idoudo 23624 2006/5/15 23:34:00
iamdream 大哥，我不知道怎么联系你；请教个问题。
为什么你的这个速度那么快，我从stringgrid to excel的和你的速度差远了（大量数据时）！！
dodge 22995 2006/4/17 22:13:10
怎么我用的时候要把
//DataSet := dgrSource.DataSource.DataSet;
//CurPos  := DataSet.GetBookmark;
这两句注释了才行呢？？？
不懂为什么。。。
dodge 22989 2006/4/17 16:25:47
简直太爱你了。。
正好用到这个东东。。免得去写打印了/
直接导入EXCEL再打印。。。
pperjer 22971 2006/4/16 17:12:23
根据iamdream兄弟的思路，修改的适应从Developer Express的TcxGridDBBandedTableView直接将数据导出到excel中，另外再加了标题和制表属性，表头居中，细实线等功能，实际应用中速度还是很可以的，1000条记录大概需要8秒左右，如果用单独线程执行3秒就ok（本人实际采用的方式），非常感谢iamdream兄弟，哈哈，有机会大碗喝酒。

function dxDBViewToExcel(dxDBViewSource : TcxGridDBBandedTableView;sTitle : String;
          UpAniInfo: TUpAniInfoProc = nil): Integer;
var //从cxGird导出到excel
  MyExcel, varCells: Variant;
  MySheet, MyCells, Cell1, Cell2, Range: OleVariant;
  iRow, iCol, iRealCol, iSheetIdx, iVarCount, iCurRow, iFieldCount: integer;
  CurPos: TBookmark;
  DataSet: TDataSet;
  sFieldName: string;
begin
  DataSet :=  dxDBViewSource.DataController.DataSource.DataSet;
  DataSet.DisableControls;
  CurPos  := DataSet.GetBookmark;
  DataSet.First;

  try
    MyExcel := CreateOleObject('Excel.Application');
  except
    on Exception do raise exception.Create('无法创建Xls文件，请确认是否安装EXCEL')
  end;
  MyExcel.WorkBooks.Add;
  MyExcel.Visible := False;

  if DataSet.RecordCount <= MAX_VAR_ONCE then
    iVarCount := DataSet.RecordCount
  else
    iVarCount := MAX_VAR_ONCE;

  iFieldCount := dxDBViewSource.VisibleColumnCount;        //仅导出显示的列
  for iCol:=0 to dxDBViewSource.VisibleColumnCount-1 do
    if not dxDBViewSource.Columns[iCol].Visible then  //可能有不显示的列 2005.9.10
      Dec(iFieldCount);
  varCells  := VarArrayCreate([1,
          iVarCount,
          1,
          iFieldCount], varVariant);
  iSheetIdx := 1;
  iRow      := 0;
  Result    := 0;
  while not DataSet.Eof do
  begin
    if (iRow = 0) or (iRow > MAX_SHEET_ROWS + 1) then
    begin          //新增一个Sheet
      if iSheetIdx <= MyExcel.WorkBooks[1].WorkSheets.Count then
        MySheet := MyExcel.WorkBooks[1].WorkSheets[iSheetIdx]
      else
        MySheet := MyExcel.WorkBooks[1].WorkSheets.Add(NULL, MySheet);//加在后面
      MyCells := MySheet.Cells;
      Inc(iSheetIdx);
      iRow := 1;

      MySheet.Rows[1].RowHeight := 30; //第一行的行高
      MySheet.Range[MyCells.Item[1,1] ,MyCells.Item[1,dxDBViewSource.ColumnCount]].Borders[1].Weight := 2;
      MySheet.Range[MyCells.Item[1,1] ,MyCells.Item[1,dxDBViewSource.ColumnCount]].Borders[2].Weight := 2;
      MySheet.Range[MyCells.Item[1,1] ,MyCells.Item[1,dxDBViewSource.ColumnCount]].Borders[3].Weight := 2;
      MySheet.Range[MyCells.Item[1,1] ,MyCells.Item[1,dxDBViewSource.ColumnCount]].Borders[4].Weight := 2;
      MySheet.Range[MyCells.Item[1,1] ,MyCells.Item[1,dxDBViewSource.ColumnCount]].HorizontalAlignment := $FFFFEFF4;
      MySheet.Range[MyCells.Item[1,1] ,MyCells.Item[1,dxDBViewSource.ColumnCount]].VerticalAlignment := $FFFFEFF4;


      iRealCol := 0;
      for iCol := 1 to iFieldCount do
      begin
        MySheet.Cells[1, iCol].Font.Bold := True;
        {MySheet.Select;
        MySheet.Cells[iRow,iCol].Select;
        MyExcel.Selection.Font.Bold := true;}//这种方法也可(Sheet.Select不可少)
        while not dxDBViewSource.Columns[iRealCol].Visible do
          Inc(iRealCol);          //跳过不可见的列 2005.9.10
        //MySheet.Cells[1, iCol] := dgrSource.Columns[iRealCol].Title.Caption;
        MySheet.Cells[1, iCol] := dxDBViewSource.Bands[iRealCol].Caption;
        MySheet.Columns[iCol].ColumnWidth := abs(dxDBViewSource.Bands[iRealCol].Width/7);

        //MySheet.Columns[iCol].ColumnWidth := //2005.9.9 以下方法似乎算得还行
        //  Integer(Round(dgrSource.Columns[iRealCol].Width * 2
        //  / abs(dgrSource.Font.Height)));

        //sFieldName := dgrSource.Columns[iRealCol].FieldName;
        sFieldName := dxDBViewSource.Columns[iRealCol].DataBinding.FieldName;
        if (DataSet.FieldByName(sFieldName).DataType = ftString)
          or (DataSet.FieldByName(sFieldName).DataType = ftWideString) then
        begin          //对于“字符串”型数据则设Excel单元格为“文本”型
          MySheet.Columns[iCol].NumberFormatLocal := '@';
        end;
        Inc(iRealCol);
      end;
      Inc(iRow);
    end;
    iCurRow := 1;
    while not DataSet.Eof do
    begin
      iRealCol := 0;
      for iCol := 1 to iFieldCount do
      begin
        while not dxDBViewSource.Columns[iRealCol].Visible do
          Inc(iRealCol);          //跳过不可见的列 2005.9.10
        sFieldName := dxDBViewSource.Columns[iRealCol].DataBinding.FieldName;
        if ''=sFieldName then
          varCells[iCurRow, iCol] :=''
        else
          varCells[iCurRow, iCol] := DataSet.FieldByName(sFieldName).AsString;
        Inc(iRealCol);
      end;
      MySheet.Rows[iCurRow+1].RowHeight := 20;
      Inc(iRow);
      Inc(iCurRow);
      Inc(Result);
      DataSet.Next;
      if (iCurRow > iVarCount) or (iRow > MAX_SHEET_ROWS + 1) then
      begin
        if Assigned(UpAniInfo) then
          UpAniInfo(Format('(已导出%d条)', [Result])); //显示已导出条数
        Application.ProcessMessages;
        Break;
      end;
    end;
    Cell1 := MyCells.Item[iRow - iCurRow + 1, 1];
    Cell2 := MyCells.Item[iRow - 1,
          iFieldCount];
    Range := MySheet.Range[Cell1 ,Cell2];
    Range.Value := varCells;

    Range.Font.Size := 10;

    Range.Borders[1].Weight := 2;
    //Range.Borders.Item[1].LineStyle := 'xlContinuous';
    Range.Borders[2].Weight := 2;
    //Range.Borders.Item[2].LineStyle := 'xlContinuous';
    Range.Borders[3].Weight := 2;
    //Range.Borders.Item[3].LineStyle := 'xlContinuous';
    Range.Borders[4].Weight := 2;
    //Range.Borders.Item[4].LineStyle := 'xlContinuous';

    if (iRow > MAX_SHEET_ROWS + 1) then     //一个Sheet导出结束
    begin
      MySheet.Select;
      MySheet.Cells[1, 1].Select;    //使得每一Sheet均定位在第一格
    end;
    Cell1    := Unassigned;
    Cell2    := Unassigned;
    Range    := Unassigned;

  end;

  MyExcel.WorkBooks[1].WorkSheets[1].Select;   //必须先选Sheet  2005.8.23
  MyExcel.WorkBooks[1].WorkSheets[1].Cells[1,1].Select;
  MyExcel.Visible := True;
  MyExcel.WorkBooks[1].Saved := True;
  
  //插入表属性
  MyExcel.ActiveSheet.Rows[1].Insert;
  MyExcel.worksheets[1].range[MyCells.Item[1,1] ,MyCells.Item[1,dxDBViewSource.ColumnCount]].Merge(True);
  MySheet.Rows[1].RowHeight := 18;
  MySheet.Cells[1, 1].Font.Size := 10;
  MySheet.Range[MyCells.Item[1,1] ,MyCells.Item[1,dxDBViewSource.ColumnCount]].HorizontalAlignment := $FFFFEFF4;
  MySheet.Range[MyCells.Item[1,1] ,MyCells.Item[1,dxDBViewSource.ColumnCount]].VerticalAlignment := $FFFFEFF4;
  MySheet.Cells[1, 1] := '制表人：'+G_strUserName+'     制表日期：'+FormatDateTime('YYYY年MM月DD日',Now);

  //插入标题
  MyExcel.ActiveSheet.Rows[1].Insert;
  MyExcel.worksheets[1].range[MyCells.Item[1,1] ,MyCells.Item[1,dxDBViewSource.ColumnCount]].Merge(True);
  MySheet.Rows[1].RowHeight := 40;
  MySheet.Cells[1, 1].Font.Size := 20;
  MySheet.Cells[1, 1].Font.Bold := True;
  MySheet.Cells[1, 1].Font.Name := '黑体';
  MySheet.Range[MyCells.Item[1,1] ,MyCells.Item[1,dxDBViewSource.ColumnCount]].HorizontalAlignment := $FFFFEFF4;
  MySheet.Range[MyCells.Item[1,1] ,MyCells.Item[1,dxDBViewSource.ColumnCount]].VerticalAlignment := $FFFFEFF4;
  MySheet.Cells[1, 1] := sTitle;

  //最后插入顶行和头列
  MyExcel.ActiveSheet.Rows[1].Insert;
  MySheet.Rows[1].RowHeight := 5;
  MyExcel.ActiveSheet.Columns[1].Insert;
  MyExcel.ActiveSheet.Columns[1].ColumnWidth := 0.5;

  
  //MyCells  := Unassigned;
  //varCells := Unassigned;
  //MyExcel  := Unassigned;

  //清除声明的变量，直接copy的可用上面的方式清除
  VarClear(MyCells);
  VarClear(varCells);
  VarClear(MyExcel);
  if CurPos <> nil then
  begin
    DataSet.GotoBookmark(CurPos);
    DataSet.FreeBookmark(CurPos);
  end;
  DataSet.EnableControls;

end;
iamdream 22258 2006/3/20 13:10:42
只要将代码中最后的MyExcel.Visible := True去掉就不显示Excel了。
idoudo 21918 2006/3/5 16:12:34
能不能不打开excel啊，我只是想把它保存下就OK了！~！我条用了你的函数，马上就打开了 excel了
ntjrr 21349 2006/2/4 19:18:44
检测EXCEL是否安装的代码是能正常运行了，写在这边供高手指点斧正。
代码在begin后第一行就执行
try
  MyExcel := CreateOleObject('Excel.Application');
  except
  showmessage('没有安装Excel');
  Result:=0;
  exit;
  end;
  MyExcel.WorkBooks.Add;
  MyExcel.Visible := False;
  DataSet := dgrSource.DataSource.DataSet;//
  DataSet.DisableControls;
  CurPos  := DataSet.GetBookmark;
  DataSet.First;// dataset的几个执行代码好象要放在下面，否则如果用户电脑没装EXCEL后就会发现DBGRID里的内容都不好控制了。
以下代码照旧
......
......
ntjrr 21338 2006/2/3 20:54:15
iamdream的代码确实是现今为止我用过的导出到EXCEL的最快的了。但有时候用户不一定装有EXCEL，能否加一个检测是否装有EXCEL的代码，如果没装就提示，我自己试过了，加上去也成功了，但编绎时总有提示：[Warning] DBGrid2Excel.pas(41): Return value of function 'DBGridToExcel' might be undefined，不知道iamdream能否在百忙之中再修改一下，谢谢！
blacksheep2005 20863 2006/1/11 18:06:10
真是好东西啊！
我在D2005下测试，只有下面这句有点问题。
错误提示： 不能设置类range的ColumnWidth属性?         
MySheet.Columns[iCol].ColumnWidth := //2005.9.9 以下方法似乎算得还行
          Integer(Round(dgrSource.Columns[iCol-1].Width * 2
          / abs(dgrSource.Font.Height)));
还有就是宽度可不可以自动调节啊？
zxzcad 19818 2005/12/8 15:52:00
再次感谢,想了好的,还想更好.现在 有个难题,
再导出的确记录中,我想每隔10行,合并第一字段单元格,并且给所选区域加上边框,请问应该怎么做啊.我特地做了一张图,让你看个明白.

http://kslive.vicp.net/1.jpg

花生最近有点问题可能有时不能访问
iamdream 19810 2005/12/8 9:10:41
呵呵，我不抽烟，而且我很不喜欢烟味。^o^
zxzcad 19798 2005/12/7 11:33:05
哎呀,叫我怎么感谢你呢!!请你抽烟吧!关键时刻帮了我大忙了.谢谢
iamdream 19603 2005/11/29 11:56:22
UpdateAniInfo是一个提示的函数，你可在窗体中定义一个类似的函数：
procedure TForm1.UpdateAniInfo(const sInfo: string);
begin          //更新动画提示信息
  LabelWaitInfo.Caption := sInfo;  //在PanelWaiting中放一个TLabel，取名LabelWaiting
  PanelWaiting.Update();          //在窗体中央放一个TPanel，取名PanelWaiting
end;
jack011 19600 2005/11/29 11:10:01
非常感谢iamdream，好东西啊！
速度很快噢！
你有动态进度的例子吗？
能否发我一份。
jack011@126.com
谢谢高手。
xm5151 19104 2005/11/11 10:15:54
真是爱死你了！
hugu 18772 2005/10/30 21:16:01
感谢CCTV,感谢China卫视,感谢我的经纪公司,特别感谢 iamdream 解决了我最头疼的问题.为此我感觉发现了新大陆,兴奋的一夜未眠...哈哈..iamdream 助我也...爽!!!

我是个 菜菜鸟 iamdream 编的 DBGrid2Excel.PAS 我没看懂, I'm Sorry.

请帮我写两行调用 DBGridToExcel() 与 DataSetToExcel 的 全参数 调用实例.谢谢.

函数 UpdateAniInfo(const sInfo: string); 调用实例没有看明白, I'm Sorry,again.

procedure TForm1.UpdateAniInfo(const sInfo: string);
begin          //更新动画提示信息
  LabelWaitInfo.Caption := sInfo;
  PanelWaiting.Update();
end;

这段程序放在哪里呀?我把这段贴去提示错误:
[Error] ArrearageOverallInfoFU.pas(1032): E2003 Undeclared identifier: 'UpdateAniInfo'
我在 局部变量中定义也出错.
  private
    { Private declarations }
procedure UpdateAniInfo(const sInfo: string);

错误提示:
[Error] ArrearageOverallInfoFU.pas(1040): E2003 Undeclared identifier: 'PanelWaiting'

********** 我的撕页 **********
Unit ......, DBGrid2Excel ;

//<欠费信息 Form> ==> <未垫付欠费 Function Panel C:Notebook>
//[导出到 Excel] - SpeedButton G  Click 事件
procedure TArrearageOverallInfoForm.Fun_C_SB_GClick(Sender: TObject);
Begin
DBGridToExcel(Function_C_DBGrid); //引用 ~iamdream~ DBGrid2Excel.Unit
End;
调用：DBGridToExcel(Function_C_DBGrid);成功
调用：DBGridToExcel(Function_C_DBGrid, UpdateAniInfo);失败

我想像一下发现要是没有 Excel 2000 这个"家伙"咋办呀? 能不能在 <用户权限> 处加入什么代码能判断 Excel 是否有效?

设计窗体时默认 False
Fun_C_SB_G.Enabled 设 False

..........
判断 Excel 是否安装
..........
Fun_C_SB_G.Enabled:= < Excel = 有效> ;  //取消禁用 [导出到 Excel]
..........

请iamdream 指点.(最好是编好的代码,嘿嘿,我不会编程呀) Thank You...
iamdream 18753 2005/10/29 11:33:01
我这个函数不是显示进度条的，只是显示文本信息；
你要显示进度条，你得自己修改代码，你看一下UpAniInfo调用处.
csyr 18610 2005/10/22 22:31:41
导出速度确实很快。
但设置用第二个参数显示进度条没有测试成功，不知如何调用？是否在窗体上放置progressbar1进度条控件？PanelWaiting和UpdateAniInfo是什么控件？能否给出更具体的例子？谢谢！
shangjin 18270 2005/10/7 22:09:18
谢谢iamdream
第一页 上一页 下一页 最后页 有 57 条纪录 共3页 21 - 40
 用户名：
 密　码：
自动登陆(30天有效)
 
  DELPHI盒子版权所有 技术支持:深圳市麟瑞科技有限公司 1999-2024 V4.01 粤ICP备10103342号-1 更新RSS列表