Exporter un dataset vers excel via xml

0/5 (5 avis)

Snippet vu 20 128 fois - Téléchargée 31 fois

Contenu du snippet

You can create excel worksheet using XML is a easier ways to work with excel files but works only with Office 2003 up

Source / Exemple :


procedure TfrmCBSSReport.Dataset2XLSXML(DataSet:TDataSet; sFile:String);
Const
   sHeadXML       = '<?xml version="1.0" encoding="UTF-8"?>';
   sWorkBookBegin = '<Workbook xmlns="urn:schemas-microsoft-com:office:spreadsheet"'+
                    ' xmlns:x="urn:schemas-microsoft-com:office:excel"'+
                    ' xmlns:ss="urn:schemas-microsoft-com:office:spreadsheet"'+
                    ' xmlns:html="http://www.w3.org/TR/REC-html40">';
   sEndWorkBook   = '</Workbook>';
   sEndWorkSheet  = ' </Worksheet>';
   sTable         = '  <Table>';
   sEndTable      = '  </Table>';
   sRow           = '   <Row>';
   sEndRow        = '   </Row>';
   sCell          = '    <Cell>';
   sEndCell       = '</Cell>';

Var
  sXlsXml:String;
  iColumn:Integer;
  reXLSXML:TStringList;
  ftXLSXML:TextFile;

begin
 //log file
 AssignFile(ftXLSXML,sFile);
 {$I-}
 Reset(ftXLSXML);
 {$I+}
 if IOResult <> 0 then
 begin
   Rewrite(ftXLSXML);
 end;

 Append(ftXLSXML);
 Writeln(ftXLSXML,sHeadXML);
 Flush(ftXLSXML);

 Append(ftXLSXML);
 Writeln(ftXLSXML,sWorkBookBegin);
 Flush(ftXLSXML);

 Append(ftXLSXML);
 Writeln(ftXLSXML,' <Worksheet ss:Name="Table1">');
 Flush(ftXLSXML);

 //Add columns
 For iColumn:=0 to DataSet.FieldCount -1 do
 begin
   sXlsXml := sXlsXml + '   <Column ss:Index="'+IntToStr(iColumn+1)+'" ss:AutoFitWidth="0" ss:Width="110"/>';
 end;
 Append(ftXLSXML);
 Writeln(ftXLSXML,sXlsXml+sRow);
 Flush(ftXLSXML);

 //Add Cells definitions (Titles)
 For iColumn:=0 to DataSet.FieldCount -1 do
 begin
   Append(ftXLSXML);
   Writeln(ftXLSXML,sCell+'<Data ss:Type="String">'+DataSet.Fields[iColumn].FieldName+'</Data>'+sEndCell);
   Flush(ftXLSXML);
 end;
 Append(ftXLSXML);
 Writeln(ftXLSXML,sEndRow);
 Flush(ftXLSXML);

 While Not DataSet.Eof do
 begin
   Append(ftXLSXML);
   Writeln(ftXLSXML,sRow);
   Flush(ftXLSXML);

   //Add each value by field
   For iColumn:=0 to DataSet.FieldCount -1 do
   begin               
     Append(ftXLSXML);
     Writeln(ftXLSXML,sCell+'<Data ss:Type="String">'+DataSet.FieldByName(DataSet.Fields[iColumn].FieldName).AsString +'</Data>'+sEndCell);
     Flush(ftXLSXML);
   end;
   Append(ftXLSXML);
   Writeln(ftXLSXML,sEndRow);
   Flush(ftXLSXML);

   DataSet.Next;
 end;

 Append(ftXLSXML);
 Writeln(ftXLSXML,sEndTable);
 Flush(ftXLSXML);

 Append(ftXLSXML);
 Writeln(ftXLSXML,sEndWorkSheet);
 Flush(ftXLSXML);

 Append(ftXLSXML);
 Writeln(ftXLSXML,sEndWorkbook);
 Flush(ftXLSXML);

 CloseFile(ftXLSXML);

{ another way to do
  reXLSXML := TStringList.Create;
  reXLSXML.PlainText := True;

  reXLSXML.Add(sHeadXML);
  reXLSXML.Add(sWorkBookBegin);
  reXLSXML.Add(' <Worksheet ss:Name="Table1">');
  reXLSXML.Add(sTable);

  //Add columns
  For iColumn:=0 to DataSet.FieldCount -1 do
  begin
    sXlsXml := sXlsXml + '   <Column ss:Index="'+IntToStr(iColumn+1)+'" ss:AutoFitWidth="0" ss:Width="110"/>';
  end;
  reXLSXML.Add(sXlsXml+sRow);

  //Add Cells definitions (Titles)
  For iColumn:=0 to DataSet.FieldCount -1 do
  begin
    reXLSXML.Add(sCell+'<Data ss:Type="String">'+DataSet.Fields[iColumn].FieldName+'</Data>'+sEndCell);
  end;
  reXLSXML.Add(sEndRow);

  While Not DataSet.Eof do
  begin
    reXLSXML.Add(sRow);
    //Add each value by field
    For iColumn:=0 to DataSet.FieldCount -1 do
    begin               //'+getDataType(DataSet.Fields[iColumn].DataType)+'
      reXLSXML.Add(sCell+'<Data ss:Type="String">'+DataSet.FieldByName(DataSet.Fields[iColumn].FieldName).AsString +'</Data>'+sEndCell);
    end;
    reXLSXML.Add(sEndRow);
    DataSet.Next;
  end;

  reXLSXML.Add(sEndTable);
  reXLSXML.Add(sEndWorkSheet);
  reXLSXML.Add(sEndWorkbook);

  reXLSXML.SaveToFile(sFile);
  reXLSXML.Free;
  }
end;

procedure TfrmCBSSReport.SpeedButton1Click(Sender: TObject);
begin
   Dataset2XLSXML(query1,'c:\test.xls');
end;

A voir également

Ajouter un commentaire Commentaires
gii_dagostino Messages postés 2 Date d'inscription samedi 8 mars 2008 Statut Membre Dernière intervention 10 juin 2015
10 juin 2015 à 11:32
Tres bien
joseeeef Messages postés 1 Date d'inscription samedi 16 décembre 2000 Statut Membre Dernière intervention 21 juin 2011
21 juin 2011 à 17:48
utyuytu
vaughan Messages postés 198 Date d'inscription mardi 6 août 2002 Statut Membre Dernière intervention 29 octobre 2008
18 janv. 2006 à 09:35
oh !!!
En plus de parler le français, je parle courament le Pascal (entre autre)...
Et BEGIN c'est pascal (entre autre) et END aussi (entre autre)
SamDotNet Messages postés 11 Date d'inscription lundi 24 février 2003 Statut Membre Dernière intervention 15 avril 2006
18 janv. 2006 à 00:30
tant pis pour toi!
BEGIN c'est anglais et END aussi!
Désolé mais pas de reproche!!!
vaughan Messages postés 198 Date d'inscription mardi 6 août 2002 Statut Membre Dernière intervention 29 octobre 2008
26 oct. 2005 à 09:53
Hi guy,

This is the "French" Web Site ... and it's correct to speak "French" .. DELPHI[FR] = DELPHI en Français.

C'est un site Francophone, et le but est d'alimenter les petits developpeur Francophone que l'on est.

Sinon ta source en interresante et depuis la mise en place de office 2003, l'utilisation du XML ouvre pas mal de voie.

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.