有没有源代码??

解决方案 »

  1.   

    将三个Recordset中的东西,分别导入三个sheet中。function Tdbtoexcel.SaveDbToExcel(title1:String;rs1:_Recordset;
                               title2:String;rs2:_Recordset;
                               title3:String;rs3:_Recordset):Boolean;
    var
      i, j: integer;       
      EApplication: TExcelApplication;
      EWorkBook: TExcelWorkbook;
      EWorkSheet: TExcelWorksheet;
      fieldName,fieldProperty,fieldValue:WideString;
    begin
      Result := false;  EApplication := nil;
      EWorkBook := nil;
      EWorkSheet := nil;
      try
        try
          EApplication := TExcelApplication.Create(nil);
          EWorkBook := TExcelWorkbook.Create(nil);
          EWorkSheet := TExcelWorksheet.Create(nil);
        except
          Application.MessageBox('对不起,没有找到Excel,请安装Excel!','错误',MB_OK + MB_ICONERROR);
          exit;
        end;
        EApplication.Connect;
        EApplication.Workbooks.Add(null,0);
        EWorkBook.ConnectTo(EApplication.WorkBooks[1] as _WorkBook);
        EApplication.Caption := self.CaptionString;
        if rs1 <> nil then
        begin
          EWorkSheet.ConnectTo(EWorkBook.Worksheets[1] as _WorkSheet);
          for i := 0 to rs1.RecordCount - 1 do
          begin
            for j := 0 to rs1.Fields.Count - 1 do
              EWorkSheet.Cells.Item[i+2,j+1] := GetString(rs1.Fields[j].Value);
            rs1.MoveNext;
          end;
        end;
        if rs2 <> nil then
        begin
          EWorkSheet.ConnectTo(EWorkBook.Worksheets[2] as _WorkSheet);
          for i := 0 to rs2.RecordCount - 1 do
          begin
            for j := 0 to rs2.Fields.Count - 1 do
              EWorkSheet.Cells.Item[i+2,j+1] := GetString(rs2.Fields[j].Value);
            rs2.MoveNext;
          end;
        end;
        if rs3 <> nil then
        begin
          EWorkSheet.ConnectTo(EWorkBook.Worksheets[3] as _WorkSheet);
          if title3 <> '' then
          for i := 0 to rs3.RecordCount - 1 do
          begin
            for j := 0 to rs3.Fields.Count - 1 do
              EWorkSheet.Cells.Item[i+2,j+1] := GetString(rs3.Fields[j].Value);
            rs3.MoveNext;
          end;
        end;
        EApplication.Visible[1] := true;
      finally
        EApplication.Disconnect;
        EWorkBook.Disconnect;
        EWorkSheet.Disconnect;
        EApplication.Free;
        EWorkBook.Free;
        EWorkSheet.Free;
      end;
      
      result := true;
    end;
      

  2.   

    sorry 把if title3 <> '' then删掉:)
    title1,title2,title3没用。