Written by xinyiman Dicembre 19, 2011, 09:37:00 am21289 ViewsRating: 0 (0 Rates)Print
Se implementate nei vostri progetti questa mia libreria, che necessita dell'installazione di questo componente http://wiki.lazarus.freepascal.org/FPSpreadsheet allora potrete esportare il contenuto di un DataSource in excel. Quella che segue è la libreria
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.
Per usare questa libreria basta inserire la voce MyExcel nella sezione unit e nel codice da eseguire usiamo il seguente esempio:
if ExportToExcel(DS_MiaQuery, "c:\", "FileOut.xls" , "Foglio1", Errore)=TRUE then ShowMessage("Esportato") else ShowMessage("Errore: " + Errore);
Dove il primo parametro (DS_MiaQuery) è il DataSource a cui è collegata la mia query da esportare, il secondo parametro stabilisce in quale cartella andare a salvare il file excel (bisogna avere i permessi di scrittura in tale directory, es "c:\"), il terzo parametro è il nome che vogliamo dare al file excel, il quarto parametro è il nome che vogliamo assegnare al foglio del documento excel, e l'ultimo parametro è una variabile passata per referenza in cui inserisco il messaggio d'errore se qualcosa va storto. Se tale funzione ha esito positivo ritorna TRUE diversamente ritorna FALSE.
About the author
xinyiman registered at Italian community of Lazarus and Free Pascal on Ottobre 14, 2011, 10:56:28 pm and has posted 3271 posts in the boards since then. Last visit was Oggi alle 08:25:59 am.
Questo blog non rappresenta una testata giornalistica poiché viene
aggiornato senza alcuna periodicità. Non può pertanto considerarsi un
prodotto editoriale ai sensi della legge n. 62/2001.
Questo sito utilizza cookie, anche di terze parti, per offriti servizi in linea con le tue preferenze. Chiudendo questo banner, scorrendo questa pagina, cliccando su un link o proseguendo la navigazione in altra maniera, acconsenti all’uso dei cookie.