Italian community of Lazarus and Free Pascal

{
     Libreria scritta da Sammarco Francesco
     francesco.sammarco@gmail.com
}

unit MyExcel;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, fpspreadsheet, fpsallformats, fpstypes, laz_fpspreadsheet, sqldb, db;

const OUTPUT_FORMAT = sfExcel5;

function ExportToExcel(MiaQuery: TDataSource; MyDir: string; NomeFile: string; NomeFoglio: string; var Errore: string): boolean;

implementation

     function ExportToExcel(MiaQuery: TDataSource; MyDir: string; NomeFile: string; NomeFoglio: string; var Errore: string): boolean;
     var
     	ret: BOOLEAN;
        rst: TDataSet;
        MyWorkbook: TsWorkbook;
        MyWorksheet: TsWorksheet;
        Riga, i, Qta: integer;
        posizione: integer;
     begin
             if MiaQuery.DataSet.RecordCount>0 then
             begin
               posizione:=MiaQuery.DataSet.RecNo;
               MiaQuery.DataSet.DisableControls;
               Errore:='';
       	     ret:=TRUE;
               try
                 try
                    rst:=MiaQuery.DataSet;
                    rst.First;
                    if not rst.EOF then
                    begin
                          Riga:=0;
             		// Create the spreadsheet
             		MyWorkbook := TsWorkbook.Create;
             		MyWorksheet := MyWorkbook.AddWorksheet(NomeFoglio);
             		Qta:=rst.Fields.Count;
                          //stampo la testata
                          for i:=0 to Qta-1 do
                          begin
                               if (rst.FieldDefs.Items[i].Name='') then
                                  MyWorksheet.WriteUTF8Text(Riga, i, 'Campo' + IntToStr(i))
                               else
                                   MyWorksheet.WriteUTF8Text(Riga, i, rst.FieldDefs.Items[i].Name);
                               MyWorksheet.WriteFontStyle(Riga, i, [fssBold]); //metto la cella in grassetto
                          end;
                          Inc(Riga);
             		//stampo i dati sul foglio excel
              rst.First;
              while not rst.EOF do
              begin
                               for i:=0 to Qta-1 do
                               begin
                                    if i=6 then
                                       Errore:=rst.Fields[i].AsString;

                                    if (rst.Fields[i].DataType=ftFloat) then
                                         MyWorksheet.WriteNumber(Riga, i, rst.Fields[i].AsFloat)
                                    else if (rst.Fields[i].DataType=ftCurrency) then
                                              MyWorksheet.WriteNumber(Riga, i, rst.Fields[i].AsCurrency)
                                    else if (rst.Fields[i].DataType=ftLargeint) then
                                              MyWorksheet.WriteNumber(Riga, i, rst.Fields[i].AsLargeInt)
                                    else if (rst.Fields[i].DataType=ftSmallint) then
                                              MyWorksheet.WriteNumber(Riga, i, rst.Fields[i].AsInteger)
                                    else if (rst.Fields[i].DataType=ftInteger) then
                                         MyWorksheet.WriteNumber(Riga, i, rst.Fields[i].AsInteger)
                                    else if (rst.Fields[i].DataType=ftString) then
                                         MyWorksheet.WriteUTF8Text(Riga, i, rst.Fields[i].AsString)
                                    else
                                        MyWorksheet.WriteUTF8Text(Riga, i, rst.Fields[i].AsString);
                               end;
                               Inc(Riga);
                   rst.Next;
              end;

              // Save the spreadsheet to a file
              MyWorkbook.WriteToFile(MyDir + System.DirectorySeparator + NomeFile + STR_EXCEL_EXTENSION, OUTPUT_FORMAT);
              MyWorkbook.Free;
             end
             else
             begin
             	ret:=FALSE;
             end;
               	finally
          	end;
       		except
                          on E: Exception do
                          begin
                               Errore:=E.Message;
                               ret:=FALSE;
                          end;
             	end;
                  MiaQuery.DataSet.RecNo:=posizione;
                  MiaQuery.DataSet.EnableControls;

             end else begin
                  Errore:='Data empty';
                  ret:=false;
             end;

             result:=ret;
     	end;

end.

     if ExportToExcel(DS_MiaQuery, "c:\", "FileOut.xls" , "Foglio1", Errore)=TRUE then
           ShowMessage("Esportato")
     else
           ShowMessage("Errore: " + Errore);