Re: Export DataSet to Excel --use Excel directly

From: Bear (dogbear_at_163.net)
Date: 10/31/03

  • Next message: Anders Ohlsson (Borland): "Re: Delphi 8 Only for .NET Framework?" 
    Date: Fri, 31 Oct 2003 09:50:08 +0800

    {*******************************************************}
    { }
    { DataSet to Excel }
    { }
    { copyrgiht (c) 1999,2003 Bear }
    { }
    { www.delphidevelopers.com }
    { }
    {*******************************************************}

    unit uExcelTools;

    interface

    const
      C_CanNotStartExcel = 'Can not call Mircorsoft Excel! '+chr(13)+chr(10)+
                      'Please check whether Mircorsoft Excel is installed¡£';
      C_Note ='note';
      C_ExcelFilter = 'Microsoft Excel File|*.xls';

    uses
      classes, comctrls, stdctrls, windows, Dialogs, controls, SysUtils,
      Db,forms,DBClient,ComObj;

    { export dataset to excel *** }
    function DataSetToExcel***
                (
                 DataSet :TDataSet;
                 FieldTagMax :Integer;
                 *** :OleVariant
                 ): Boolean;

    { export dataset to excel }
    function DataSetToExcel
               (
                DataSet :TDataSet; //SourceDataSet
                FieldTagMax :Integer; //if the tag of the field is less than
    the value, export it
                Visible :Boolean; //Whether open Excel
                ExcelFileName:String=''//Result File Name
                ): Boolean;

    implementation

    function
    DataSetToExcel***(DataSet:TDataSet;FieldTagMax:Integer;***:OleVariant):
    Boolean;
    var
      Row,Col,FieldIndex :Integer;
      BK:TBookMark;
    begin
      Result := False;
      if not Dataset.Active then
        Exit;
      BK:=DataSet.GetBookMark;
      DataSet.DisableControls;

      ***.Activate;
      try
        //Col Title
        Row:=1;
        Col:=1;
        for FieldIndex:=0 to DataSet.FieldCount-1 do
        begin
          if DataSet.Fields[FieldIndex].Tag <= FieldTagMax then
          begin
            ***.Cells(Row,Col) :=DataSet.Fields[FieldIndex].DisplayLabel;
            Inc(Col);
          end;
        end;

        //Table Content
        DataSet.First;
        while not DataSet.Eof do
        begin
          Row:=Row+1;
          Col:=1;
          for FieldIndex:=0 to DataSet.FieldCount-1 do
          begin
            if DataSet.Fields[FieldIndex].Tag <= FieldTagMax then
            begin
              ***.Cells(Row,Col):=DataSet.Fields[FieldIndex].AsString;
              Inc(Col);
            end;
          end;
        DataSet.Next;
        end;

        Result := True;

        finally
          DataSet.GotoBookMark(BK);
          DataSet.FreeBookMark(BK);
          DataSet.EnableControls;
        end;

    end;

    function DataSetToExcel(
               DataSet:TDataSet;FieldTagMax:Integer;
               Visible:Boolean;ExcelFileName:String=''): Boolean;
    var
      ExcelObj, Excel, WorkBook, ***: OleVariant;
      OldCursor:TCursor;
      SaveDialog:TSaveDialog;
    begin
      Result := False;
      if not Dataset.Active then
        Exit;

      OldCursor:=Screen.Cursor;
      Screen.Cursor:=crHourGlass;

      try
        ExcelObj := CreateOleObject('Excel.***');
        Excel := ExcelObj.Application;
        Excel.Visible := Visible ;
        WorkBook := Excel.Workbooks.Add ;
        Sheet:= WorkBook.Sheets[1];
      except

    MessageBox(GetActiveWindow,C_CanNotStartExcel,C_Note,MB_OK+MB_ICONINFORMATIO
    N);
        Screen.Cursor:=OldCursor;
        Exit;
      end;

      Result:=DataSetToExcel***(DataSet,FieldTagMax,***) ;
      if Result then
        if not Visible then
        begin
          if ExcelFileName<>'' then
            WorkBook.SaveAs(FileName:=ExcelFileName)
          else begin
            SaveDialog:=TSaveDialog.Create(Nil);
            SaveDialog.Filter := C_ExcelFilter;
            Result:=SaveDialog.Execute;
            UpdateWindow(GetActiveWindow);
            if Result then
              WorkBook.SaveAs(FileName:=SaveDialog.FileName);
            SaveDialog.Free;
          end;
         Excel.Quit;
       end;

      Screen.Cursor:=OldCursor;
    end;

    end.

    {

                _/_/_/_/ _/_/_/_/ _/_/ _/_/_/
               _/ _/ _/ _/ _/ _/ _/
              _/_/_/ _/_/_/ _/_/ _/ _/_/_/
             _/ _/ _/ _/ _/ _/ _/
            _/_/_/_/ _/_/_/_/ _/ _/ _/ _/

    }

  • Next message: Anders Ohlsson (Borland): "Re: Delphi 8 Only for .NET Framework?"
    • Quantcast