Einzelnen Beitrag anzeigen

Eppos

Registriert seit: 7. Aug 2006
Ort: Heilbronn
523 Beiträge
 
Delphi 11 Alexandria
 
#3

AW: DataSet in Excel exportieren, Integer immer 64 als Wert

  Alt 24. Sep 2012, 14:14
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;
  Mit Zitat antworten Zitat