DBR Delphi-Ecke

// Getestet mit D4 unter WinME

// 1.
// Die Zellen eines Stringgrids werden als Excel-Datei gesichert. Es
// muss kein Excel auf dem Rechner installiert sein. Es werden alle Zellen
// des Grids als Strings behandelt, auch wenn diese eine "Zahl" enthalten.

function SaveAsExcel(grd: TStringGrid; FName: TFilename): boolean; 
const 
  anfang: array[0..11] of byte = (9, 8, 8, 0, 0, 0, 16, 0, 0, 0, 0, 0); 
  ende: array[0..3] of byte = (10, 0, 0, 0); 
var 
  ms: TMemoryStream; 
  x, y, lg: integer; 
  zelle: array[0..5] of word; 
begin 
  result := false; 
  ms := TMemoryStream.create; 
  try 
    zelle[0] := 516; 
    zelle[4] := 0; 
    ms.WriteBuffer(anfang, 12); 
    for y := grd.fixedrows to grd.rowcount - 1 do 
      for x := grd.fixedcols to grd.colcount - 1 do begin 
        lg := length(grd.cells[x, y]); 
        zelle[1] := lg + 8; 
        zelle[2] := y - grd.fixedrows; 
        zelle[3] := x - grd.fixedcols; 
        zelle[5] := lg; 
        ms.writebuffer(zelle, 12); 
        ms.writebuffer(pchar(grd.cells[x, y])^, lg); 
      end; 
    ms.writebuffer(ende, 4); 
    ms.savetofile(FName); 
    result := true; 
  finally 
    ms.free; 
  end; 
end; 
 
procedure TForm1.Button6Click(Sender: TObject); 
begin 
  if not SaveAsExcel(stringgrid1, 'c:\test.xls') 
    then showmessage('Fehler'); 
end;

//----------------------------------------------------------

// 2.
// Beim folgenden Code werden (im Gegensatz zu oben) Zahlen auch als solche
// gespeichert. Voraussetzung ist, dass sie keine Tausenderpunkte enthalten.
// Es muss Excel auf dem Rechner installiert sein.

uses ComObj; 
 
procedure SaveAsExcelOle(grd: TStringGrid; FName: TFilename); 
var 
  xcl, wkb: variant; 
  x, y: integer; 
  dummy: double; 
begin 
  try 
    xcl := createOleObject('Excel.Application'); 
  except 
    showmessage('Speichern fehlgeschlagen'); 
    exit; 
  end; 
  if fileexists(FName) then deletefile(pchar(FName)); 
  wkb := xcl.workbooks.add; 
  for y := 1 to grd.rowcount - 1 do 
    for x := 1 to grd.colcount - 1 do begin 
      try 
        dummy := strtofloat(grd.cells[x, y]); 
        xcl.cells[y, x] := stringreplace(grd.cells[x, y], ',', '.', []); 
      except 
        xcl.cells[y, x] := grd.cells[x, y]; 
      end; 
    end; 
  wkb.saveas(FName); 
  xcl.quit; 
end; 
 
procedure TForm1.Button7Click(Sender: TObject); 
begin 
  SaveAsExcelOle(stringgrid1, 'c:\test.xls'); 
end;