Exporter un dataset vers excel via xml

Soyez le premier à donner votre avis sur cette source.

Snippet vu 19 026 fois - Téléchargée 29 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

vaughan
Messages postés
207
Date d'inscription
mardi 6 août 2002
Statut
Membre
Dernière intervention
29 octobre 2008
-
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.
SamDotNet
Messages postés
11
Date d'inscription
lundi 24 février 2003
Statut
Membre
Dernière intervention
15 avril 2006
-
tant pis pour toi!
BEGIN c'est anglais et END aussi!
Désolé mais pas de reproche!!!
vaughan
Messages postés
207
Date d'inscription
mardi 6 août 2002
Statut
Membre
Dernière intervention
29 octobre 2008
-
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)
joseeeef
Messages postés
1
Date d'inscription
samedi 16 décembre 2000
Statut
Membre
Dernière intervention
21 juin 2011
-
utyuytu
gii_dagostino
Messages postés
2
Date d'inscription
samedi 8 mars 2008
Statut
Membre
Dernière intervention
10 juin 2015
-
Tres bien

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.