谁能提供一份ADODataSet数据导出到EXCEL的解决方案

Question

你是说将表中的数据如显示在DBGRID中一样显示在SHEET中吗？

Answer 1

可以试一下用FORMULA ONE 的f1book，可以实现这个功能。

Answer 2

看看吧～～需要Ｕｓｅｓ那个～～Comobj;
procedure DataToExcel(Grid:TDbGrid;DataSet:TDataset;Title:String;sExcelFile:String);
var
    i,j,Row:integer;
    WB: _WorkBook;
    WBs: Workbooks;
    FExcelWasFound:Boolean;
    ExcelFile:string;
    FileHandle: integer;
    irange:range;
    iWidth:integer;
    //oFont:olevariant;
begin
  try
  Screen.Cursor :=crHourGlass    ;
  {for i:=0 to Grid.Columns.Count -1 do
  begin
    Dataset.Fields[i].DisplayWidth :=Grid.Columns[i].Width;
  end;    }
  ExcelFile:=sExcelFile;
  if not fileExists(ExcelFile) then
  begin
    FileHandle:=FileCreate(ExcelFile);
    Fileclose(FileHandle);
  end;
  FExcelWasFound := True;
  try
    FApp := CreateOleObject('Excel.Application.9') as _Application;  //调用Excel2000
  except
    FExcelWasFound := False;
  end;
  if not FExcelWasFound then                  //如果不存在，则调用Excel97
    try
      FApp := CreateOleObject('Excel.Application.8') as _Application;
      FExcelWasFound := True;
    except
      FExcelWasFound := False;
      ShowMessage('Excel调用失败！');
    end;
  if FExcelWasFound then
  begin
    InitVariables;
    New(FSPms);
    with FApp ,FSPms^ do
    begin
      App_SheetsInNewWorkbook := Get_SheetsInNewWorkbook(0);
      App_DisplayFormulaBar := Get_DisplayFormulaBar(0);
      App_ReferenceStyle := Get_ReferenceStyle(0);
      App_DisplayStatusBar := Get_DisplayStatusBar(0);
      Set_SheetsInNewWorkbook(0, 1);
      WBs := Get_Workbooks;                //打开Excel文件
      WB := WBs.Open(excelFile, 3, false, 1,
        '', '', True, $00000002, 1, False,
          False, Null, False, 0);
      MakeVBScript(WB);              //初始化文件属性
    end;
    with FApp do
    begin
      Set_DisplayFormulaBar(0, False);
      Set_ReferenceStyle(0, Integer(xlR1C1));
      Set_DisplayStatusBar(0, False);
      Set_Caption(Title);
    end;
    try
    Row:=1;
    irange:=Fapp.ActiveCell ;
    irange.Font.Size :=9;
    for j:=0 to Grid.FieldCount -1 do
    begin
      if Grid.Columns[j].Visible =true then
      begin
        if DataSet.Fields[j].displaywidth>254 then
          iRange.ColumnWidth:=100
        else
        begin
          //iWidth:=Grid.Columns[j].Width;
          iRange.ColumnWidth :=Grid.Columns[j].Field.DisplayWidth  ;
        end;
        irange.Font.Size :=9;  //ljq 2001/03/09
        irange.value:=Grid.Columns[j].Title.Caption  ;
        irange:=irange.Next;
      end;
    end;
    except
      ShowMessage('调用Excel出错！');
      fApp._Release;
      Screen.Cursor :=crDefault    ;
      exit;
    end;
    Row:=Row+2;
    DataSet.DisableControls;
    DataSet.First;
    FApp.Get_ActiveWindow.DisplayZeros := True;
    irange.NumberFormat:=10;
    for i:=0 to DataSet.RecordCount -1 do
    begin
      irange:=Fapp.Range['A'+IntToStr(Row),'A'+intToStr(Row)];
      for j:=0 to Grid.FieldCount -1 Do
      begin
        if Grid.Columns[j].Visible =True then
        begin
          if Grid<>nil then
          begin
            iRange.Font.Size :=Grid.Font.Size;
            iRange.Font.Name :=Grid.Font.Name;
          end
          else
          begin
            irange.Font.Size :=FFontSize;
            irange.Font.Name :=FFontName;
          end;  //edit by ljq 2001/03/09
          iRange.Value :=Grid.Columns[j].Field.AsString ;
          irange:=iRange.Next ;
        end;
      end;
      DataSet.next;
      Row:=Row+1;
    end;
    Screen.Cursor :=crDefault    ;
    DataSet.EnableControls;
    irange:=FApp.Range['A1','K'+intToStr(Row-1)];
    FApp.Set_Visible(0,True);
    CreateToolBar(False);      //屏蔽Excel的系统菜单,采用自定义菜单实现
  end else
  begin
    ShowMessage('调用Excel2000或Excel97失败，请确认是否安装！'+#13#13+' 如果未安装，请先安装office');
    Screen.Cursor :=crDefault    ;
  end;
  except
    ShowMessage('调用Excel出错！');
    fApp._Release;
    Screen.Cursor :=crDefault    ;
    exit;
  end;
end; 

Answer 3

tikkypeng(千两狂死郎)的代码好经典哦！我已经看到好几遍了，好象没有一个、
关于导数据到excel的问题，就会有你和你的代码出现！说笑而已，其实他的代码是正确的

Answer 4

哈哈～～我的程序由于公司要求保密～～所以每次只能给大家看这个了～～ｔｏ　：cobi(小新国际)见笑了～～：）其实我最开始就是参考这一段代码写的导出Ｅｘｃｅｌ的～～
比较经典的～～

Answer 5

谢谢cobi(小新国际)提醒～～
我想起来我还有自己作的例子～～：）
给大家看看～～请指正错误～～谢谢了～～procedure TForm1.Button1Click(Sender: TObject);
var
  i,j,h,k:Integer;
  handle : HWND;
begin
  {Handle := FindWindow('XLMAIN', nil);    //判断Excel是否执行
  if handle <> 0 then
    showmessage('Excel is Running!')
  else
    showmessage('not Excel is Running!');
  }
  ExcelExistFlag := True;
  try
    EApp := CreateOleObject('Excel.Application.9') as _Application;  //Excel2000
  except
    ExcelExistFlag := False;
  end;
  if not ExcelExistFlag then
  try
    EApp := CreateOleObject('Excel.Application.8') as _Application;  //Excel97
    ExcelExistFlag := True;
  except
    ExcelExistFlag := False;
    ShowMessage('Excel调用失败！');
  end;  //EApp := CreateOleobject('Excel.Application');  if ExcelExistFlag then
  begin
    ADOQuery1.DisableControls;
    EApp.Visible:=true;
    //EApp.Caption := '还不行??';
    //EApp.Workbooks.Add;
    EApp.Workbooks.Add(xlWBatWorkSheet);
    EApp.Workbooks[1].WorkSheets[1].Name := Label1.Caption;
    ESheet := EApp.Workbooks[1].WorkSheets[Label1.Caption];
    ExcelCellRange := EApp.WorkBooks[1].WorkSheets[Label1.Caption].Columns;
    ADOQuery1.First;    for j:=0 to ADOQuery1.FieldCount-1  do
    begin
      //ESheet.Cells[1,j+1] :='';
      //ESheet.Cells[2,j+1] :='';
      //ESheet.Cells[3,j+1] :='';
      h:=Trunc(ADOQuery1.FieldCount/2);   
      ESheet.Cells[1,h] :='北京XX公司';
      ESheet.Cells[2,h] :='用户信息表';
      ESheet.Cells[3,h] :='';
      ESheet.Cells[4,j+1] := DBGrid1.Columns[j].Title.Caption;
      //EApp.WorkBooks[1].WorkSheets[1].Cells[4,j+1].ColumnWidth := DBGrid1.Columns[j].Width;
      EApp.WorkBooks[1].WorkSheets[1].Cells[4,j+1].Borders.LineStyle := xlContinuous; //边框类型
      EApp.WorkBooks[1].WorkSheets[1].Cells[4,j+1].Borders.Weight := xlMedium;        //边框粗细
      //ExcelCellRange.Columns[j+1].ColumnWidth :=DBGrid1.Columns[j].Field.Size;// DisplayWidth  ;
      ExcelCellRange.Columns[j+1].ColumnWidth := DBGrid1.Columns[j].Width/7;
      //ExcelCellRange.Columns.Item[j+1].Name:=DBGrid1.Columns[j].Title.Caption ;
      //ExcelCellRange.Characters.Font.Name := '宋体'; //字体
      //ExcelCellRange.Characters.Font.FontStyle := '加粗';
      //ExcelCellRange.Characters.Font.Size := 9;
      //ExcelCellRange.Characters.Font.Color := clBlue; //颜色
      //ExcelCellRange.Characters.Font.ColorIndex := xlAutomatic; //颜色
      //ExcelCellRange := EApp.WorkBooks[1].WorkSheets[1].Range['A1:D4'];
      //ExcelCellRange.Borders.LineStyle := xlDouble;
    end;
    for i:=1 to ADOQuery1.RecordCount  do
    begin
      for j:=1 to ADOQuery1.FieldCount  do
      begin
        ESheet.Cells[i+4,j] :=ADOQuery1.Fields[j-1].AsString;
        EApp.WorkBooks[1].WorkSheets[1].Cells[i+4,j].Borders.LineStyle := xlContinuous; //边框类型
        EApp.WorkBooks[1].WorkSheets[1].Cells[i+4,j].Borders.Weight := xlThin;          //边框粗细
        //ESheet.Cells[i+2,j].Characters.Font.Name := '宋体'; //字体
        //ESheet.Cells[i+2,j].Characters.Font.FontStyle := '';
        //ESheet.Cells[i+2,j].Characters.Font.Size := 9;      //大小
        //ESheet.Cells[i+2,j].Characters.Font.Color := clRed; //颜色
        //ESheet.Cells[i+1,j].Characters.Font.ColorIndex := xlAutomatic; //颜色
      end;
      ADOQuery1.next;
    end;
    k:=ADOQuery1.RecordCount+8;
    ESheet.Cells[k,1] :='★TikkyPeng★';
    ESheet.Cells[k,h] :=DateToStr(Date);   //'2001-03-14';
    ESheet.Cells[k,ADOQuery1.FieldCount] :='☆★☆★☆★☆'; //'千两狂死郎打印';
    //HandleRange;
    ADOQuery1.EnableControls;
    //EApp.Visible:=True;
  end
  else
    ShowMessage('调用Excel2000或Excel97失败，请确认是否安装！'+#13#13+'如果未安装，请先安装office');
    //ExcelCellRange.Characters.Font.Name := '宋体'; //字体
    //ExcelCellRange.Characters.Font.FontStyle := '';
    //ExcelCellRange.Characters.Font.Size := 9;
    {EApp.WorkBooks[1].WorkSheets[1].Range['A1'].Borders[xlBottom].LineStyle := xlContinuous;
    EApp.WorkBooks[1].WorkSheets[1].Range['A1'].Borders[xlBottom].Weight := xlHairline;
    EApp.WorkBooks[1].WorkSheets[1].Range['A2'].Borders[xlBottom].LineStyle := xlDash;  //虚线
    EApp.WorkBooks[1].WorkSheets[1].Range['A2'].Borders[xlBottom].Weight := xlThin;  //虚线
    EApp.WorkBooks[1].WorkSheets[1].Range['A3'].Borders.LineStyle := xlContinuous;
    EApp.WorkBooks[1].WorkSheets[1].Range['A3'].Borders.Weight := xlMedium;
    EApp.WorkBooks[1].WorkSheets[1].Range['A4'].Borders[xlBottom].LineStyle := xlDashDot;
    EApp.WorkBooks[1].WorkSheets[1].Range['A4'].Borders[xlBottom].Weight := xlThick;
    }
end;procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
  EApp.DisplayAlerts := False;     //不存盘退出
  EApp.Quit;
end;procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  if not varIsEmpty(EApp) then EApp.Quit;
end;procedure TForm1.HandleRange;
begin
  ExcelCellRange := EApp.WorkBooks[1].WorkSheets[Label1.Caption].Columns;
  //ExcelCellRange := EApp.WorkBooks[1].WorkSheets[Label1.Caption].Range['A1:B4'];
  //ExcelCellRange.Formula := '=RAND()';
  ExcelCellRange.Columns.Interior.Color := ClWhite;
  ExcelCellRange.Borders.LineStyle := xlDouble;
  ExcelCellRange.HorizontalAlignment := xlHAlignRight; //水平对齐方式
  ExcelCellRange.VerticalAlignment := xlCenter; //垂直对齐方式  {单元格}
  {xlCellTypeBlanks = $00000004;
  xlCellTypeConstants = $00000002;
  xlCellTypeFormulas = $FFFFEFE5;
  xlCellTypeLastCell = $0000000B;
  xlCellTypeComments = $FFFFEFD0;
  xlCellTypeVisible = $0000000C;
  xlCellTypeAllFormatConditions = $FFFFEFB4;
  xlCellTypeSameFormatConditions = $FFFFEFB3;
  xlCellTypeAllValidation = $FFFFEFB2;
  xlCellTypeSameValidation = $FFFFEFB1;}  {单元格边框}
  {xlContinuous = $00000001;   //正常线条
  xlDash = $FFFFEFED;          //虚线
  xlDashDot = $00000004;       //虚线
  xlDashDotDot = $00000005;    //虚线
  xlDot = $FFFFEFEA;           //虚点
  xlDouble = $FFFFEFE9;        //双层线
  xlSlantDashDot = $0000000D;  //斜虚线
  xlLineStyleNone = $FFFFEFD2;}//没有边框
 
end;