Delphi 保存到 EXCEL

保存 GRID 内容到 EXCEL 文件

// 保存 GRID 内容到 EXCEL2000 文件
function tdm.SaveExcel2(fn:string; grid:TDBGrid ):boolean;
var
    excel,book,sheet : variant;
    i:integer;

    colIndex, fldIndex : Array[0..255] of integer;
    colCount : Integer;
    rec : _Recordset;

//    grid : TDBGrid;

   procedure setvalue(i,j:integer; v:variant) ; // 在单元格写入值
   begin
      sheet.cells[i,j].value := v;
   end;

   function FindColumn(idx : Integer):Integer; // 查找需要的列现在在何处
   begin
        result := 0;
        while result<255 do
        begin
            if fldIndex[result]=idx then
            begin
                exit;
            end;
            inc(result);
        end;
   end;

   procedure MoveColumn(fc,tc : Integer);  // 移动某列到某处
   var  tmp,v : Integer;
   begin
        Sheet.Columns[fc+1].Cut;
        Sheet.Columns[tc+1].Insert(-4161);
        v := fldIndex[fc];
        for tmp:=fc downto tc+1 do
            fldIndex[tmp] := fldIndex[tmp-1];
        fldIndex[tc] := v; 
   end;
begin
    result := false;
    try // 显示沙漏光标
        screen.Cursor := -11;

    try
       excel := createoleobject('excel.application');
    except
       dm.ShowErr(noExcel);
       exit;
    end;

    book := excel.workbooks.add;
    sheet := book.worksheets.item[1];
//    excel.visible:=true;
    rec := (grid.DataSource.DataSet as TAdoquery).Recordset;

    for i := rec.Fields.Count-1  downto 0 do // 第一行标题
    begin
        setvalue(1,i+1,rec.Fields[i].Name);
    end;

    sheet.cells[2,1].CopyFromRecordset( rec ); // 内容

    // 此处调整列顺序
    for i:=0 to rec.Fields.Count-1 do
        fldIndex[i] := i;

    ColCount := 0;
    for i:=0 to grid.Columns.Count-1 do
    begin
        if grid.Columns[i].Visible then
        begin
            colIndex[colCount] := grid.Columns[i].Field.Index;
            inc(colCount);
        end;
    end;

    for i:=0 to colCount-1 do
    begin
        if colIndex[i]<>fldIndex[i] then
        begin
            MoveColumn( findColumn(colIndex[i]),i );
        end;
    end;

    for i:=1 to colCount do
    begin
        sheet.columns[i].autofit;
    end;

    for i:=colCount to rec.Fields.Count-1 do
    begin
        sheet.columns[colCount+1].delete;
    end;

    try
      book.saveas( fn );
      book.close;
    except
      excel.visible:=true;
    end;

    finally
        screen.Cursor := 0;
    end;
    excel.quit;
    result:=true;
end;