with this post I share my code with community. I wrote two featured procedures ExportDatasetToExcel and ReadDatasetToWorksheet and hope they be helpful for you.
Tested with Delphi 6
1) usage
Code: Select all
procedure TForm1.OnCustomFormatExcelCell(ADataSet: TDataSet;
AIsNowFieldNamesRow, AIsNowRecNoColumn: boolean; const AFieldName: string;
var AFontColor, ABGColor: TColor; var AFontStyle: TFontStyles;
var AShowBorder: boolean);
begin
if AIsNowRecNoColumn and not AIsNowFieldNamesRow then
ABGColor := clYellow;
end;
//------------------------------------------------------------------------------
procedure TForm1.btnExportNachExcelClick(Sender: TObject);
var
sExt : string;
sFileName : string;
begin
if radXLS.Checked then
sExt:='.xls'
else
sExt:='.xlsx';
sFileName := ExtractFilePath(Application.ExeName) + 'Export'+sExt;
ExportDatasetToExcel(DSListe, // ADataSet
sFileName, // AFullXLSXFilePath
true, // ADoOpenAfter
'Table of results', // AWorksheetName
expFixedFieldNamesRow, // AFieldNamesOpt
true, // ADoFirstColumnWithRecNo
OnCustomFormatExcelCell, // ACustomFormatEvent
clXLSXFieldNamesRowBG, // AFieldNamesBGColor
false, // ADoShowCellsBorder
clXLSXEverySecondRowBG, // AEverySecondRowColor
true, // ADoFreezeDataset
false, // AIgnoreWarningsIfNumberStoredAsText
6); // AMemoColumnWidthMultiplicator: integer
end;
Code: Select all
{
MIT License
Copyright (c) 2017 Simon Kroik
Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the "Software"), to deal
in the Software without restriction, including without limitation the rights
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
copies of the Software, and to permit persons to whom the Software is
furnished to do so, subject to the following conditions:
The above copyright notice and this permission notice shall be included in all
copies or substantial portions of the Software.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
SOFTWARE.
}
//Version 1.1 (10.03.2017)
UNIT MyExcelExportUtils;
INTERFACE
uses Classes, DB, Graphics, SysUtils, XLSSheetData5;
const
clXLSXFieldNamesRowBG = clSkyBlue;
clXLSXEverySecondRowBG = TColor($00E1FFE1);
type
EMyXLSXExportException = class(Exception)
end;
TExcelExporterFieldNamesRowOpt = (expFixedFieldNamesRow,
expMovableFieldNamesRow,
expWithoutFieldNamesRow);
TCustomFormatExcelCellEvent = procedure (ADataSet: TDataSet;
AIsNowFieldNamesRow: boolean;
AIsNowRecNoColumn: boolean;
const AFieldName: string;
var AFontColor: TColor;
var ABGColor: TColor;
var AFontStyle: TFontStyles;
var AShowBorder: boolean) of object;
//Replacement for XLSWriter.Read();
procedure ReadDatasetToWorksheet(ADataSet: TDataSet;
AWorksheet: TXLSWorksheet;
AFieldNamesOpt: TExcelExporterFieldNamesRowOpt = expFixedFieldNamesRow;
ADoFirstColumnWithRecNo: boolean = false;
ACustomFormatEvent: TCustomFormatExcelCellEvent = nil;
AFieldNamesBGColor: TColor = clXLSXFieldNamesRowBG;
ADoShowCellsBorder: boolean = false;
AEverySecondRowColor: TColor = clDefault;
ADoFreezeDataset: boolean = false;
AIgnoreWarningsIfNumberStoredAsText: boolean = false;
AMemoColumnWidthMultiplicator: integer = 6);
procedure ExportDatasetToExcel(ADataSet: TDataSet;
const AFullXLSXFilePath: string;
ADoOpenAfter: boolean = false;
const AWorksheetName: string = 'Table';
AFieldNamesOpt: TExcelExporterFieldNamesRowOpt = expFixedFieldNamesRow;
ADoFirstColumnWithRecNo: boolean = false;
ACustomFormatEvent: TCustomFormatExcelCellEvent = nil;
AFieldNamesBGColor: TColor = clXLSXFieldNamesRowBG;
ADoShowCellsBorder: boolean = false;
AEverySecondRowColor: TColor = clDefault;
ADoFreezeDataset: boolean = false;
AIgnoreWarningsIfNumberStoredAsText: boolean = false;
AMemoColumnWidthMultiplicator: integer = 6);
IMPLEMENTATION
uses
Windows, ShellAPI, DateUtils,
XLSReadWriteII5, XLSDbRead5, Xc12Manager5, Xc12Utils5, XLSUtils5,
Xc12DataStyleSheet5, XLSFormattedObj5, Xc12DataWorksheet5;
function TAlignmentToXc12HorizAlignment(
AAlignment: TAlignment): TXc12HorizAlignment;
begin
case AAlignment of
taLeftJustify: Result:=chaLeft;
taRightJustify: Result:=chaRight;
taCenter: Result:=chaCenter;
else Result:=chaGeneral; //darf nie passieren
end;
end;
procedure SetCellFontStyle(ACell: TXLSCell; AFontStyle: TFontStyles);
var
CellFontStyle : TXc12FontStyles;
begin
CellFontStyle:=[];
if fsBold in AFontStyle then CellFontStyle:=CellFontStyle+[xfsBold];
if fsItalic in AFontStyle then CellFontStyle:=CellFontStyle+[xfsItalic];
if fsStrikeOut in AFontStyle then CellFontStyle:=CellFontStyle+[xfsStrikeOut];
ACell.FontStyle := CellFontStyle;
if fsUnderline in AFontStyle then ACell.FontUnderline:=xulSingle;
end;
//------------------------------------------------------------------------------
function IsStringLooksLikeNumber(const AStr: string): boolean;
var
iSumNumbers : integer;
iSumDecSeparators : integer;
iSumOthers : integer;
i : integer;
C : char;
begin
iSumNumbers := 0;
iSumDecSeparators := 0;
iSumOthers := 0;
for i:= 1 to Length(AStr) do
begin
C:=AStr[i];
case C of
'0','1','2','3','4','5','6','7','8','9': Inc(iSumNumbers);
'.',',': Inc(iSumDecSeparators);
else Inc(iSumOthers);
end;
end; //for i
Result:=(iSumOthers = 0) and
(iSumNumbers > 0) and
(iSumDecSeparators < 2);
end;
//------------------------------------------------------------------------------
function CountNumberOfThisChar(AChar: char; const AStr: string): integer;
var
i : integer;
C : char;
begin
Result := 0;
for i:= 1 to Length(AStr) do
begin
C:=AStr[i];
if AChar=C then Inc(Result);
end;
end;
//------------------------------------------------------------------------------
procedure ApplyDateTimeFieldFormatToCell(AField: TField; ACell: TXLSCell);
var
sFldDisplayFormat : string;
sNewCellFormat : AxUCString;
bWithDate : boolean;
iNumTimeSeparators: integer;
begin
sNewCellFormat := '';
if AField.DataType = ftDate then
sNewCellFormat := ExcelStandardNumFormats[XLS_NUMFMT_STD_DATE]
else
if AField.DataType = ftTime then
sNewCellFormat := ExcelStandardNumFormats[XLS_NUMFMT_STD_TIME]
else
begin
if AField is TDateTimeField then
sFldDisplayFormat:=TDateTimeField(AField).DisplayFormat
else
if AField is TSQLTimeStampField then
sFldDisplayFormat:=TSQLTimeStampField(AField).DisplayFormat
else
sFldDisplayFormat:='';
if Trim(sFldDisplayFormat) = '' then
sFldDisplayFormat:=AField.EditMask;
if Trim(sFldDisplayFormat)<>'' then
begin
bWithDate := (Pos('/',sFldDisplayFormat)>0) or
(Pos('.',sFldDisplayFormat)>0);
iNumTimeSeparators := CountNumberOfThisChar(':', sFldDisplayFormat);
if iNumTimeSeparators=0 then
sNewCellFormat := ExcelStandardNumFormats[XLS_NUMFMT_STD_DATE]
else
if bWithDate and (iNumTimeSeparators=1) then
sNewCellFormat := 'dd/mm/yyyy hh:mm'
else
if bWithDate and (iNumTimeSeparators=2) then
sNewCellFormat := 'dd/mm/yyyy hh:mm:SS'
else
if not bWithDate and (iNumTimeSeparators=1) then
sNewCellFormat := 'hh:mm'
else
if not bWithDate and (iNumTimeSeparators=2) then
sNewCellFormat := 'hh:mm:SS';
end; //if Trim(sFldDisplayFormat)<>''
end; //if AField.DataType = ftDateTime
if sNewCellFormat<>'' then
ACell.NumberFormat:=sNewCellFormat;
end;
//------------------------------------------------------------------------------
procedure ReadDatasetToWorksheet(ADataSet: TDataSet;
AWorksheet: TXLSWorksheet;
AFieldNamesOpt: TExcelExporterFieldNamesRowOpt;
ADoFirstColumnWithRecNo: boolean;
ACustomFormatEvent: TCustomFormatExcelCellEvent;
AFieldNamesBGColor: TColor;
ADoShowCellsBorder: boolean;
AEverySecondRowColor: TColor;
ADoFreezeDataset: boolean;
AIgnoreWarningsIfNumberStoredAsText: boolean;
AMemoColumnWidthMultiplicator: integer);
var
IgnoredNumErrors : TXc12IgnoredError;
iFld : integer;
iCol : integer;
iRow : integer;
Fld : TField;
iRecNo : integer;
iOrigRecNo : integer;
BGColor : TColor;
bNowFirstDataRow : boolean;
//-----------
(**) procedure _ApplyCellCustomFormat(AIsNowFieldNamesRow: boolean;
(**) AIsNowRecNoColumn: boolean;
(**) const AFieldName: string;
(**) ACellFontColor: TColor;
(**) ACellBGColor: TColor;
(**) ACellFontStyle: TFontStyles);
(**) var
(**) Cell : TXLSCell;
(**) CellFontColor : TColor;
(**) CellBGColor : TColor;
(**) CellFontStyle : TFontStyles;
(**) bShowBorder : boolean;
(**) begin
(**) if AWorksheet.AsString[iCol,iRow]='' then
(**) AWorksheet.AsString[iCol,iRow]:=''; //Create cell if not exists
(**)
(**) Cell := AWorksheet.Cell[iCol, iRow];
(**)
(**) CellFontColor := ACellFontColor;
(**) CellBGColor := ACellBGColor;
(**) CellFontStyle := ACellFontStyle;
(**) bShowBorder := ADoShowCellsBorder;
(**)
(**) if Assigned(ACustomFormatEvent) then
(**) begin
(**) ACustomFormatEvent(ADataSet,
(**) AIsNowFieldNamesRow,
(**) AIsNowRecNoColumn,
(**) AFieldName,
(**) CellFontColor,
(**) CellBGColor,
(**) CellFontStyle,
(**) bShowBorder);
(**) end;
(**)
(**) if CellFontColor <> clDefault then
(**) Cell.FontColor:=ColorToRGB(CellFontColor);
(**)
(**) if CellBGColor <> clDefault then
(**) Cell.FillPatternForeColor:=TColorToClosestIndexColor(CellBGColor);
(**)
(**) if bShowBorder then
(**) begin
(**) AWorksheet.Cell[iCol, iRow].BorderLeftStyle:=cbsThin;
(**) AWorksheet.Cell[iCol, iRow].BorderRightStyle:=cbsThin;
(**) AWorksheet.Cell[iCol, iRow].BorderTopStyle:=cbsThin;
(**) AWorksheet.Cell[iCol, iRow].BorderBottomStyle:=cbsThin;
(**) end;
(**)
(**) if CellFontStyle <> [] then
(**) SetCellFontStyle(Cell,
(**) CellFontStyle);
(**) end;
//-----------
(**) procedure _AddHeaderCell(const AText: string;
(**) AAlign: TAlignment;
(**) AIsNowRecNoColumn: boolean;
(**) const AFieldName: string);
(**) begin
(**) AWorksheet.AsString[iCol, iRow]:=AText;
(**)
(**) AWorksheet.Cell[iCol, iRow].HorizAlignment:=
(**) TAlignmentToXc12HorizAlignment(AAlign);
(**)
(**) _ApplyCellCustomFormat(true, // AIsNowFieldNamesRow
(**) AIsNowRecNoColumn, // AIsNowRecNoColumn
(**) AFieldName, // AFieldName
(**) clDefault, // ACellFontColor
(**) AFieldNamesBGColor, // ACellBGColor
(**) [fsBold]); // ACellFontStyle
(**)
(**) iCol:=iCol+1;
(**) end;
//-----------
begin
IgnoredNumErrors := nil;
iRow:= 0;
//######### First Row #########
bNowFirstDataRow:=false;
if AFieldNamesOpt <> expWithoutFieldNamesRow then
begin
iCol:= 0;
//Rec-No
if ADoFirstColumnWithRecNo then
_AddHeaderCell('#', // AText
taLeftJustify, // AAlign
true, // AIsNowRecNoColumn
''); // AFieldName
//Field-Names
for iFld:=0 to ADataSet.FieldCount-1 do
begin
Fld := ADataSet.Fields.Fields[iFld];
if Fld.Visible then
_AddHeaderCell(Fld.DisplayName, // AText
Fld.Alignment, // AAlign
false, // AIsNowRecNoColumn
Fld.FieldName); // AFieldName
end;
if AFieldNamesOpt=expFixedFieldNamesRow then
AWorksheet.FreezePanes(0, 1);
Inc(iRow);
end;
//######### FieldValues #########
bNowFirstDataRow := true;
if ADoFreezeDataset then
ADataSet.DisableControls();
try
iOrigRecNo := ADataSet.RecNo;
ADataSet.First();
iRecNo := 1;
while not ADataSet.Eof do
begin
if (iRecNo mod 2) = 0 then
BGColor:=AEverySecondRowColor
else
BGColor:=clDefault;
iCol:= 0;
//Rec-No
if ADoFirstColumnWithRecNo then
begin
AWorksheet.AsInteger[iCol, iRow]:=iRecNo;
AWorksheet.Cell[iCol, iRow].FontStyle := [xfsBold];
AWorksheet.Cell[iCol, iRow].HorizAlignment := chaLeft;
_ApplyCellCustomFormat(false, // AIsNowFieldNamesRow
true, // AIsNowRecNoColumn
'', // AFieldName
clDefault, // ACellFontColor
BGColor, // ACellBGColor
[fsBold]); // ACellFontStyle
Inc(iCol);
end;
//Fields
for iFld:=0 to ADataSet.FieldCount-1 do
begin
Fld := ADataSet.Fields.Fields[iFld];
if Fld.Visible then
begin
AWorksheet.AsString[iCol, iRow]:='';
if (bNowFirstDataRow) then
begin
if (Fld.DataType in [ftMemo, ftFmtMemo, ftOraClob]) then
AWorksheet.Columns.SetColWidth(
iCol,iCol,
AMemoColumnWidthMultiplicator * XLS_DEFAULT_COLWIDTH
);
end;
if not Fld.IsNull then
begin
//helpful Infos are in UNIT XLSDbRead5.pas --> ReadDataSet
case Fld.DataType of
ftSmallint,
ftInteger,
ftLargeInt,
ftWord,
ftCurrency,
ftBCD,
ftFMTBcd,
ftAutoInc,
ftFloat:
AWorksheet.AsFloat[iCol, iRow]:=Fld.AsFloat;
ftTimestamp,
ftDate,
ftTime,
ftDateTime:
begin
AWorksheet.AsDateTime[iCol, iRow]:=Fld.AsDateTime;
ApplyDateTimeFieldFormatToCell(
Fld,
AWorksheet.Cell[iCol, iRow]
);
end;
else
begin
AWorksheet.AsString[iCol, iRow]:=Fld.AsString;
AWorksheet.Cell[iCol, iRow].WrapText:=(Fld.DataType=ftMemo);
if AIgnoreWarningsIfNumberStoredAsText and
IsStringLooksLikeNumber(Fld.AsString) then
begin
if not Assigned(IgnoredNumErrors) then
begin
IgnoredNumErrors := AWorksheet.Xc12Sheet.IgnoredErrors.Add();
IgnoredNumErrors.NumberStoredAsText:=true;
end;
IgnoredNumErrors.Sqref.Add(iCol, iRow, iCol, iRow);
end;
end;
end; //case Fld.DataType
AWorksheet.Cell[iCol, iRow].HorizAlignment:=
TAlignmentToXc12HorizAlignment(Fld.Alignment);
end; //if not Fld.IsNull
_ApplyCellCustomFormat(false, // AIsNowFieldNamesRow
false, // AIsNowRecNoColumn
Fld.FieldName, // AFieldName
clDefault, // ACellFontColor
BGColor, // ACellBGColor
[]); // ACellFontStyle
Inc(iCol);
end; //if Fld.Visible
end; //for iFld
ADataSet.Next();
Inc(iRow);
Inc(iRecNo);
bNowFirstDataRow:=false;
end; //while not ADataSet.Eof
ADataSet.RecNo:=iOrigRecNo;
finally
if ADoFreezeDataset then
ADataSet.EnableControls();
end;
end;
//------------------------------------------------------------------------------
procedure ExportDatasetToExcel(ADataSet: TDataSet;
const AFullXLSXFilePath: string;
ADoOpenAfter: boolean;
const AWorksheetName: string;
AFieldNamesOpt: TExcelExporterFieldNamesRowOpt;
ADoFirstColumnWithRecNo: boolean;
ACustomFormatEvent: TCustomFormatExcelCellEvent;
AFieldNamesBGColor: TColor;
ADoShowCellsBorder: boolean;
AEverySecondRowColor: TColor;
ADoFreezeDataset: boolean;
AIgnoreWarningsIfNumberStoredAsText: boolean;
AMemoColumnWidthMultiplicator: integer);
var
XLSWriter : TXLSReadWriteII5;
Worksheet : TXLSWorksheet;
begin
try
XLSWriter := TXLSReadWriteII5.Create(nil);
try
if UpperCase(ExtractFileExt(AFullXLSXFilePath))='.XLSX' then
XLSWriter.Version:=xvExcel2007
else
XLSWriter.Version:=xvExcel97;
XLSWriter.DirectWrite:=false;
XLSWriter.Filename:=AFullXLSXFilePath;
//XLSWriter.Clear(1);
Worksheet:=XLSWriter.Items[0];
Worksheet.Name:=AWorksheetName;
ReadDatasetToWorksheet(ADataSet,
Worksheet,
AFieldNamesOpt,
ADoFirstColumnWithRecNo,
ACustomFormatEvent,
AFieldNamesBGColor,
ADoShowCellsBorder,
AEverySecondRowColor,
ADoFreezeDataset,
AIgnoreWarningsIfNumberStoredAsText,
AMemoColumnWidthMultiplicator);
XLSWriter.Write();
finally
FreeAndNil(XLSWriter);
end;
if ADoOpenAfter then
ShellExecute(0, // hWND
'open', // Operation
PChar('"'+AFullXLSXFilePath+'"'), // FileName
'', // Parameters
'', // Directory
SW_SHOWNORMAL); // ShowCmd
except
on E: Exception do
raise EMyXLSXExportException.Create(E.Message);
end;
end;
//------------------------------------------------------------------------------
END.