请教如何把dataset导出成excel

Question

请教如何把dataset导出成excel，有没有这方面的控件？

Answer 1

function ExcelDataSetPrint(DataSet: TDataSet;ATitle: string): Boolean;
  procedure DrawTitle(var Range:Variant;STitle:String);
  begin
    Range.HorizontalAlignment := xlCenter;
    Range.VerticalAlignment := xlBottom;
    Range.WrapText := False;
    Range.Orientation := 0;
    Range.AddIndent := False;
    Range.ShrinkToFit := False;
    Range.MergeCells := False;
    Range.Merge;
    Range.Formula := STitle;
    Range.Font.Name := '楷体';
    Range.Font.FontStyle := '常规';
    Range.Font.Size := 16;
    Range.Font.Strikethrough := False;
    Range.Font.Superscript := False;
    Range.Font.Subscript := False;
    Range.Font.OutlineFont := False;
    Range.Font.Shadow := False;
    Range.Font.Underline := xlUnderlineStyleNone;
    Range.Font.ColorIndex := xlAutomatic;
    Range.Font.Bold := True;
    Range.Font.Color := clgreen;
  end;
var
  TheExcel,Range: Variant;
  nrow,ncol: integer;
begin
  if not DataSet.Active then
  begin
    Application.MessageBox('不能打印关闭的数据集！','提示',MB_OK+MB_ICONINFORMATION);
    Exit;
  end;
  TheExcel:=CreateOleObject('Excel.Application');
  TheExcel.visible:=false;
  TheExcel.Workbooks.add;
  TheExcel.Workbooks[1].sheets[1].name:='打印单元';  Range := TheExcel.worksheets[1].Range['A1:J1'];
  DrawTitle(Range,Format(ATitle,[]));
  nrow:=2;
  for ncol :=2 to DataSet.FieldCount + 1 do
  TheExcel.worksheets[1].cells[nRow,nCol] := DataSet.Fields[ncol-2].DisplayLabel;  nrow:=nrow+1;
  DataSet.First;  while not DataSet.Eof do
  begin
   for ncol :=2 to DataSet.FieldCount+1 do
   TheExcel.worksheets[1].cells[nRow,nCol]:=DataSet.Fields[ncol-2].AsString;
   DataSet.Next;
   nrow:=nrow+1;
  end;
  TheExcel.visible := True;
end;

Answer 2

可以使用TStringList、简单实用、生成的文件大小也要小许多//excel文件 Delimiter #9
procedure SaveDataSet(TT : TDataSet; FileName, Delimiter : String);
var
  i : integer;
  line : string;
  M : TStringList;
begin
  TT.Active := true;
  TT.First;
  M := TStringList.Create;
  Line := TT.Fields[0].DisplayName;
  For i := 1 to TT.FieldCount -1 do
    Line := Line + Delimiter + TT.Fields[i].DisplayLabel;
  M.Add(Line);
  while not TT.Eof do
  begin
    Line := TT.Fields[0].AsString;
    For i := 1 to TT.FieldCount -1 do
        Line := Line + Delimiter + StringReplace(StringReplace(TT.Fields[i].AsString,
          #13#10,' ',[rfReplaceAll]),#9,' ',[rfReplaceAll])
    M.Add(Line);
    TT.Next;
  end;
  M.SaveToFile(FileName);
end;转自：http://delphi.ktop.com.tw/topic.asp?TOPIC_ID=27241

Answer 3

procedure GenerteXLSFile(strFileName:string); 
var 
ExcelApp,MyWorkBook:Variant; 
begin 
try 
try 
ExcelApp:=CreateOleObject('Excel.Application'); 
MyWorkBook:=CreateOleobject('Excel.Sheet'); 
except 
application.Messagebox('无法打开Xls文件，请确认已 经安装EXCEL.', 
",mb_OK+mb_IconStop); 
Exit; 
end; 
MyworkBook:=ExcelApp.workBooks.Add; 
//在此处插入读数据库及写Excel文档的代码 
try 
MyWorkBook.saveas(strFileName); 
MyWorkBook.close; 
ExcelApp.Quit; 
ExcelApp:=Unassigned; //释放VARIANT变量 
except //当存为一个已有的文档而又不覆盖时将 
MyWorkBook.close; //产生一个例外 
ExcclApp.Quit; 
end; 
end;

Answer 4

//将数据导入到EXCEL中procedure TfrmPrint2.ExportDataToExcel;
var
        i, j, k: integer;
        xxx1: string;
        xr: string;
begin
        if frmPrint2.dstlist.items.count = 0 then
  begin
        application.messagebox('没有选择目标字段!', '物资管理系统', mb_iconwarning + mb_defbutton1);
        exit;
  end;
        frmPrint2.statusbar1.Panels[0].text := '正在载入Excel,请稍候......';
        frmPrint2.statusbar1.refresh;
  try
        screen.cursor := crHourGlass;
    try
      //创建EXCEL对象
      varexcel := createoleobject('excel.application');
      if not varisempty(varexcel) then
      begin
        //添加工作簿
        varexcel.workbooks.add;
        varexcel.workbooks[1].worksheets[1].name := '数据库信息';
      end;
    except
      application.messagebox('请确认是否安装Excel?', '提示信息：', mb_iconquestion + mb_defbutton1);
      exit;
    end;
    begin
      //获取数据
      getData;
      //写入列标题
      range := varexcel.workbooks[1].worksheets[1].columns;
      for i := 0 to frmPrint2.dstlist.Items.count - 1 do begin
        varexcel.workbooks[1].worksheets[1].cells[2, i + 1].value := frmPrint2.dstlist.items.strings[i];
        varexcel.workbooks[1].worksheets[1].cells[2, i + 1].Font.bold := true;
        range.columns[i + 1].columnwidth := frmPrint2.adoquery1.Fieldbyname(frmPrint2.dstlist.items.Strings[i]).Displaywidth;
        range.columns[I + 1].HorizontalAlignment := xlCenter;
      end;
      try
        try
          //循环写入数据到EXCEL中
          frmPrint2.adoquery1.First;
          j := 3;
          while not frmPrint2.adoquery1.eof do begin
            for i := 0 to frmPrint2.dstlist.Items.count - 1 do begin
              xr := ''''+frmPrint2.adoquery1.fieldbyname(frmPrint2.dstlist.items.strings[i]).AsString;
              varexcel.workbooks[1].worksheets[1].cells[j, i + 1].value := xr;
            end;
            frmPrint2.adoquery1.next;
            j := j + 1;
          end;
          varexcel.workbooks[1].worksheets[1].cells[j + 1, 2].value := '制表: ' + frmPrint2.edtLister.text;
          varexcel.workbooks[1].worksheets[1].cells[j + 1, 4].value := '日期: ' + frmPrint2.edtListDate.text;
        except
        end;
      finally
        frmPrint2.adoquery1.enablecontrols;
        frmPrint2.statusbar1.Panels[0].text := '';
        k := i - 1 + ord('A');
        xxx1 := chr(k);
        xxx1 := 'A2:' + xxx1 + inttostr(j - 1);
        //将数据表格画线
        range := varexcel.workbooks[1].worksheets[1].range[xxx1];
        range.borders.linestyle := xlcontinuous;
        k := i - 1 + ord('A');
        xxx1 := chr(k);
        xxx1 := 'a1:' + xxx1 + '1';
        //数据标题列居中
        range := varexcel.workbooks[1].worksheets[1].range[xxx1];
        range.HorizontalAlignment := xlCenter;
        range.VerticalAlignment := xlCenter;
        range.MergeCells := True;
        //对报表标题进行修饰
        varexcel.workbooks[1].worksheets[1].range['a1:a1'] := frmPrint2.edtPrintTitle.text;
        varexcel.workbooks[1].worksheets[1].range['a1:a1'].font.name := '楷体';
        varexcel.workbooks[1].worksheets[1].range['a1:a1'].font.size := '18';
        varexcel.workbooks[1].worksheets[1].range['a1:a1'].font.fontstyle := 'bold';
        varexcel.visible := true;
      end;
    end;
  finally
    screen.cursor := crArrow;
  end;
end;

Answer 5

转WWWWA(aaaa)帖子:
ado指向你的SQLSERVER：
ADOQUERY：
select * into zqqq from [try$] in "d:\rsc\try1.xls" "excel 8.0;"