Thema
:
Delphi
DataSet in Excel exportieren, Integer immer 64 als Wert
Einzelnen Beitrag anzeigen
Eppos
Registriert seit: 7. Aug 2006
Ort: Heilbronn
524 Beiträge
Delphi 11 Alexandria
#
1
AW: DataSet in Excel exportieren, Integer immer 64 als Wert
24. Sep 2012, 13:14
zusammenfalten
·
markieren
Delphi-Quellcode:
procedure
SetExcelTable( vDS : TDataSet; vForm : TForm);
const
xlWBATWorksheet = -4167;
xlContinuous = 1;
var
XLApp: Variant;
XLWorkbook: Variant;
XLSheet: Variant;
XLArrayData : OLEVariant;
XLCellBegin: Variant;
XLCellEnd: Variant;
XLRange: Variant;
iColumnsCount: Integer;
iRowsCount: Integer;
i: Integer;
j: Integer;
begin
try
XLApp.DisplayAlerts := False;
Screen.Cursor := crHourGlass;
try
XLWorkbook := XLApp.Workbooks.Add(xlWBATWorkSheet);
XLSheet := XLWorkbook.Sheets[1];
vDs.DisableControls;
iRowsCount := vDS.RecordCount + 1;
iColumnsCount:= vDS.FieldCount;
XLArrayData := VarArrayCreate([1, iRowsCount, 1, iColumnsCount], varVariant);
vDS.First;
for
i := 2
to
iRowsCount
do
begin
for
j:= 1
to
iColumnsCount
do
case
vDS.Fields.Fields[j - 1].DataType
of
ftString : XLArrayData[i, j] := vDS.Fields.Fields[j - 1].AsString;
ftInteger : XLArrayData[i, j] := vDS.Fields.Fields[j - 1].AsInteger;
ftFloat, ftCurrency : XLArrayData[i, j] := vDS.Fields.Fields[j - 1].AsFloat;
ftDate,ftDateTime :
begin
XLArrayData[i, j] := FormatDateTime( '
dd.mm.yyyy hh:mm:ss
', vDS.Fields.Fields[j - 1].AsDateTime );
XLArrayData[i, j] := StringReplace( XLArrayData[i, j], '
00:00:00
', '
', [rfReplaceAll] );
end
;
else
;
end
;
vDS.Next;
end
;
XLCellBegin := XLSheet.Cells[1, 1];
XLCellEnd := XLSheet.Cells[iRowsCount, iColumnsCount];
XLRange := XLSheet.Range[XLCellBegin, XLCellEnd];
XLRange.NumberFormat := '
@
';
XLRange.Value := XLArrayData;
XLRange.Borders.LineStyle := xlContinuous;
for
i:= 1
to
iColumnsCount
do
XLSheet.Columns[i].AutoFit;
XLApp.Visible := True;
vDs.EnableControls;
finally
vDs.EnableControls;
vForm.Enabled:= True;
Screen.Cursor := crDefault;
XLApp.DisplayAlerts:= True;
VarClear(XLArrayData);
end
;
except
vDs.EnableControls;
XLApp.Quit;
end
;
end
;
Zitat
Eppos
Öffentliches Profil ansehen
Mehr Beiträge von Eppos finden