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;
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.