Exporter un dataset vers excel via xml

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

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.