急。。求一EXCEL导出代码，马上揭贴

Question

RT

Answer 1

rocedure TFrm_student.suiButton11Click(Sender: TObject);
Var
  ExcelApp:Variant;
  SaveDialog1: TSaveDialog;
  i,j,row,column:integer;
begin
  //dm.Apps.Get_Seek_Result(querystr,1);
  with dm.ClientDataSet1 do begin
  querycount:=RecordCount;
   close;open;
  if dm.ClientDataSet1.IsEmpty then
  begin
    ShowMessage('没有数据需要存盘！');//test
    Exit;
  end;
  SaveDialog1:= TSaveDialog.Create(nil);
  SaveDialog1.Filter := 'Excel 文件 (*.xls)|*.xls';
  SaveDialog1.Title:='确定另存为excel的文件名';
  if savedialog1.Execute Then
    begin
      while S_IsFileInUse(savedialog1.FileName) do
      begin
        case Application.MessageBox(PChar('无法存盘，'+string(ExtractFileName(savedialog1.FileName))+'正在使用中'), '请确认', MB_ICONQuestion+MB_ABORTRETRYIGNORE+MB_DEFBUTTON2) of
          IDAbort:
            begin
              SaveDialog1.Free;
              Exit;
            end;
          IDRetry:
            begin
              continue;
            end;
          IDIgnore:
            begin
              if Not savedialog1.Execute then break;
            end;
        end;
      end;
    end
  else
    begin
      SaveDialog1.Free;
      exit;
    end;//if
   try
    ExcelApp:=CreateOleObject('Excel.Application');//首先创建 Excel 对象，使用ComObj
   except
    Application.Messagebox('Excel没有安装!','Hello',MB_ICONERROR + mb_Ok);
    Abort;
   end;//end try
  try
    ExcelApp.Visible := False;//显示当前窗口
    ExcelApp.Caption := '应用程序调用 Microsoft Excel';//更改 Excel 标题栏
    ExcelApp.WorkBooks.Add;//添加新工作簿：
    ExcelApp.WorkSheets[ 'Sheet1' ].Activate;//设置第1个工作表为活动工作表
    ExcelApp.ActiveSheet.Rows[1].Font.Size:=10;
    ExcelApp.ActiveSheet.Rows[1].Font.Bold := True;
    row:=1;
    column:=1;
    for j:= 0 to dm.ClientDataSet1.FieldCount-1 do
      begin
        ExcelApp.Cells[row,column].Value:=dm.ClientDataSet1.Fields[j].DisplayLabel;
        column:=column+1;
      end;
    row:=2;
    while (Not dm.ClientDataSet1.Eof) and (Not dm.ClientDataSet1.IsEmpty) do
    begin
      column:=1;
      for i:=1 to dm.ClientDataSet1.FieldCount do
        begin
          ExcelApp.Cells[row,column].Value:=dm.ClientDataSet1.fields[i-1].AsString;
          column:=column+1;
        end;
      dm.ClientDataSet1.Next;
      row:=row+1;
    end;
    if Not S_IsFileInUse(savedialog1.FileName) then
      try
        ExcelApp.ActiveWorkBook.SaveAs(savedialog1.filename);
      except
        SaveDialog1.Free;
        ExcelApp.WorkBooks.Close;
        ExcelApp.Quit;
        ExcelApp:= Unassigned;
        exit;
      end;
    SaveDialog1.Free;
    ExcelApp.WorkBooks.Close;
    ExcelApp.Quit;
    ExcelApp:= Unassigned;
    Application.MessageBox('Excel文件导出成功!','成功',MB_OK);
  except
    SaveDialog1.Free;
    ExcelApp:= Unassigned;
  end;
  end;
end;

Answer 2

用这种方式快
var
asheet,range:variant;
i,K,M,N,y :integer;
ls_FileName:string;
tsList  :TStringList;
s       :string;
begin
Screen.Cursor:=crHourGlass;
ExcelApplication1.Visible[0]:=True;
ExcelApplication1.Workbooks.Add(xlWBATWorksheet,0);
asheet:=ExcelApplication1.Worksheets.Item[1];
for i:=0 to DBGrid1.Columns.Count-1 do
asheet.cells[2,i+1].value:=Trim(DBGrid1.Columns.Items[i].Title.Caption);
K:=1;
N:=DBGrid1.Columns.count;
I:=DBGrid1.DataSource.DataSet.RecordCount;
tsList:=TStringList.Create;
try
DBGrid1.DataSource.DataSet.first;
while not DBGrid1.DataSource.DataSet.Eof do
begin
                    s:='';
                    for y:=0 to n-1 do
                    begin
                        s:=s+Trim(DBGrid1.DataSource.DataSet.Fields[y].AsString)+#9;
                        Application.ProcessMessages;
                    end;
                    tsList.Add(s);
                    DBGrid1.DataSource.DataSet.next;
                end;
            Clipboard.AsText:=tsList.Text;
    finally
        tsList.Free;
    end;
    ExcelApplication1.Disconnect;
    asheet.cells[3,1].select;
    aSheet.Paste;
    range:=asheet.range[asheet.cells[2,1],asheet.cells[DBGrid1.DataSource.DataSet.RecordCount+2,DBGrid1.DataSource.DataSet.FieldCount]];
    range.select;
    range.borders.linestyle:=1;//画线
    for i:=1 to DBGrid1.DataSource.DataSet.FieldCount do begin
    range:=asheet.range[asheet.cells[1,i],asheet.cells[DBGrid1.DataSource.DataSet.RecordCount,i]];
    range.EntireColumn.AutoFit;//自动设置为最大的字符长度
    end;
    Screen.Cursor:=crDefault;
    ExcelApplication1.Disconnect;
    aSheet:=Unassigned;//释放VARIANT变量
    DBGrid1.DataSource.DataSet.First;end;