StringGird als XLS-Datei ohne Excel abspeichern

[Chemiker]

Hallo,

also mit dieser Unit ist es möglich, die Daten in einem StringGrid in eine Excel-Datei (.XLS) ohne Excel aufzurufen, abzuspeichern. Es werden alle Daten als Text (Label) abgespeichert ohne Formatierungen.

Das ganze wird als BIFF – Format abgespeichert.
In diesem Zusammenhang noch mal ein Dank an alzaimar und Hawkeye219 für die Informationen.

Ich kann die Datei leider nur mit Excel 2000 ausprobieren.
Es wäre interessant zu wissen, ob es auch mit anderen Excel - Versionen funktioniert.


Ein Demoprogramm folgt weiter unten.

Delphi-Quellcode:

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Unit:       XLSDateiUnit
letz.Ändr.: 11.06.2008
Version:    1.10
Funktion:   In diser Unit werden für das BIFF-Format die Records zur Verfügung
            gestellt.
            Änderungen für die Migration auf Delphi 2009 durchgeführt.
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
unit XLSDateiUnit;

interface

uses Grids, Classes;

type
  TXLS_BOFRec= packed record     // Start des Datenblockes
    RecCode: Word;               // $809 BOF
    RecLaenge: Word;             // Record Länge  // Komplett 16/ normal 8
    BIFFVersion: Word;           // $ 600 BiffVersions-Nummer:8
    Bereich: Word;               // $10 = Workssheet
    ExcelVersion: Word;          // muss nicht angegeben werden 2719=Excel 2000
    ExcelDatum: Word;            // muss nicht angegeben werden
//    ExcelHistoryFlag: DWord;     // muss nicht angegeben werden
//    LetzteExcelVersion: DWord;   // muss nicht angegeben werden.
  end;

  TXLS_LABELRec= packed record    // String-Record von Excel
    RecCode: Word;                // $204 Bei Biff 8
    RecLaenge: Word;              // Record Länge // muss zuvor berechnet werden
    Row: Word;                    // Zeilen-Nr. beginnt bei 0
    Col: Word;                    // Spalten-Nr. beginnt bei 0
    IndexXFRec: Word;             // noch nicht ganz verstanden // erstmal=0
    ZellenStLeange: Word;         // Nur die ZellenString-Länge
  end;

  TXLS_EOFRec= packed record      // Ende des Datenblockes
    RecCode: Word;                // $A0
    RecLaenge: Word;              // 00  hat immer die Länge = 0
  end;

function XLS_BOFRecDatenFuellen(): TXLS_BOFRec;
function XLS_StringFuellen(const Zeile,Spalte: Word;Wert: String):TXLS_LABELRec;
function XLS_EOFRecDatenFuellen(): TXLS_EOFRec;
function ZellenInhalt(Zeile, Spalte: Integer; Tab: TStringGrid): String;
function DatenInXLSDateiUebertragen(const XLS_LWPathDateiName: string;
                                    DatenStringGrid: TStringGrid): boolean;
implementation

uses
  SysUtils;

{------------------------------------------------------------------------------}
function XLS_BOFRecDatenFuellen(): TXLS_BOFRec;
begin
  with Result do
  begin
    RecCode:= $809;
    RecLaenge:= 8;
    BIFFVersion:= 1;   // Kann auch 1 sein
    Bereich:= $10;
    ExcelVersion:= 1;
    ExcelDatum:= 0;
//    ExcelHistoryFlag:=0;
//    LetzteExcelVersion:=0;
  end;
end;
{------------------------------------------------------------------------------}
function XLS_StringFuellen(const Zeile,Spalte: Word;Wert: String):TXLS_LABELRec;
begin
  with Result do
  begin
    RecCode:= $204;
    RecLaenge:= 8 + (Length(Wert)*SizeOf(Char)); // Änderung für Delphi 2009
    Row:= Zeile;
    Col:= Spalte;
    IndexXFRec:= 0;
    ZellenStLeange:= (Length(Wert)*SizeOf(Char));  // Änderung für Delphi 2009
  end;
end;
{------------------------------------------------------------------------------}
function XLS_EOFRecDatenFuellen(): TXLS_EOFRec;
begin
  with Result do
  begin
    RecCode:= $A;
    RecLaenge:= 0;
  end;
end;
{------------------------------------------------------------------------------}
function ZellenInhalt(Zeile, Spalte: Integer; Tab: TStringGrid): String;
begin
  Result:= Tab.Cells [Spalte, Zeile];
end;
{------------------------------------------------------------------------------}
function DatenInXLSDateiUebertragen(const XLS_LWPathDateiName: string;
                                    DatenStringGrid: TStringGrid): boolean;
var
  x, i: integer;
  XLSFileStream: TFileStream;
  XLS_BOF: TXLS_BOFRec;
  XLS_EOF: TXLS_EOFRec;
  XLS_St: TXLS_LABELRec;
  Inhalt: String;
begin
  XLSFileStream:= TFileStream.Create(XLS_LWPathDateiName, fmCreate);
  Result:= FALSE;
  try
    // XLS-File Anfang schreiben
    XLS_BOF:= XLS_BOFRecDatenFuellen();
    XLSFileStream.WriteBuffer(XLS_BOF,SizeOf(XLS_BOFRecDatenFuellen()));

    // Werte aus einem StringGrid lesen und in die XLS-Datei eintragen
    for x := 0 to DatenStringGrid.ColCount - 1 do    // Max. 254  Excel-Grenze
    begin
      for I := 0 to DatenStringGrid.RowCount - 1 do  // Max 65536 Excel-Grenze
      begin
        Inhalt:= ZellenInhalt(I, x, DatenStringGrid);
        XLS_St:= XLS_StringFuellen(I, x, Inhalt);
        XLSFileStream.WriteBuffer(XLS_St, Sizeof (XLS_St));
        XLSFileStream.WriteBuffer(Inhalt[1], (Length(Inhalt)*SizeOf(Char))); // Änderung für Delphi 2009
      end;
    end;
    // Werte eintragen Ende.

    // XLS-File Ende schreiben
    XLS_EOF:= XLS_EOFRecDatenFuellen();
    XLSFileStream.WriteBuffer(XLS_EOF,SizeOf(XLS_EOFRecDatenFuellen()));
    Result:= TRUE;
  finally
    // Datei wieder schliesen.
    XLSFileStream.Free;
  end;
end;

end.

Und nun das Demoprogramm:

Delphi-Quellcode:

unit DatenGridAnzeigeUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, Grids, StdCtrls;

const
  // Daten für die StringGrid um die Überschriften Anzuzeigen.
  SPALTEN_MAX= 7;       // Max. Anzahl-Spalten im StringGrid
  ZEILEN_MAX=  10;      // Max. Anzahl-Zeilen im StringGrid
  SPALTEN_BEZ: array [0..SPALTEN_MAX-1] of String = ('Spalte 1',
                                                   'Spalte 2',
                                                   'Spalte 3',
                                                   'Spalte 4',
                                                   'Spalte 5',
                                                   'Spalte 6',
                                                   'Spalte 7');
 SPALTE1_INHALT: array [0..ZEILEN_MAX-1] of String = ('Zeile 1',
                                                      'Zeile 2',
                                                      'Zeile 3',
                                                      'Zeile 4',
                                                      'Zeile 5',
                                                      'Zeile 6',
                                                      'Zeile 7',
                                                      'Zeile 8',
                                                      'Zeile 9',
                                                      'Zeile 10');

type
  TForm1 = class(TForm)
    ExcelTabSpeichern: TSaveDialog;
    Button1: TButton;
    DatenGitter: TStringGrid;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

uses XLSDateiUnit;  // Daten aus einem StringGrid in eine XLS-Datei abspeichern.

{$R *.dfm}
{-------------------------------------------------------------------------------
 procedure: SpaltenBezInStringGrid;
 Funktion:  Damit werden die Splaten von Tab (StringGrid) beschriftet.
 Parameter: Sp_Bez:      const String-Array für die Bezeichungen der Spalten
            Tab:         TStringGrid welches beschriftet werden soll.
 letz.Ändr.: 25.06.2007
 Version:    1.00
-------------------------------------------------------------------------------}
procedure SpaltenBezInStringGrid(const Sp_Bez: array of String;
                                 Tab: TStringGrid);
var
  I: Integer;
begin
  Tab.ColCount:= High(Sp_Bez)+1;   // Soviel Spalten setzen wie es Überschriften
                                   // gibt.
  for I := 0 to High(Sp_Bez) do
  begin
    Tab.Cells[I, 0]:= Sp_Bez[I];   // Spaltenüberschriften in StringGrid
                                   // schreiben.
  end;
end;
{-------------------------------------------------------------------------------
 procedure: Spalte1ZeileSchreiben;
 Funktion:  Damit werden die Splaten von Tab (StringGrid) beschriftet.
 Parameter: Sp1_Bez:     const String-Array für die Bezeichungen der 1 Spalten
            Tab:         TStringGrid welches beschriftet werden soll.
 letz.Ändr.: 25.06.2007
 Version:    1.00
-------------------------------------------------------------------------------}
procedure Spalte1ZeileSchreiben(const Sp1_Bez: array of String;
                                Tab: TStringGrid);
var
  I: Integer;
begin
  Tab.RowCount:= High(Sp1_Bez)+1;
  for I := 0 to High(Sp1_Bez) do
  begin
    Tab.Cells[0, I]:= Sp1_Bez[I];
  end;
end;
{------------------------------------------------------------------------------}
 procedure Spalte2Bis7Fuellen(Ze: integer; Tab: TStringGrid);
 var
   I: Integer;
 begin
   Randomize;
   for I := 1 to ZEILEN_MAX- 1 do
   begin
     with Tab do
     begin
       Cells[1,I]:= TimeToStr(Time+(Random(3)/10));   // Uhrzeit eintragen
       Cells[2,I]:= FloatToStr(Random(65000)/3.2);    // Double-Zahl eintragen
       Cells[3,I]:= IntToStr(Random(100000));         // Integer-Zahlen eintragen
       Cells[4,I]:= DateToStr(Date+(Random(10)/3));   // Datums-Werte eintragen
       Cells[5,I]:= FloatToStr(Random(20000000)/3.2); // Double-Zahl eintragen
       Cells[6,I]:= FloatToStr(10*I);                 // Double-Zahl eintragen
     end;
   end;
 end;
{------------------------------------------------------------------------------}
function XLS_LWPathDateiname(const DateiVorgabe, OrdnerVorgabe: String;
                                                       SD: TSaveDialog): String;
begin
  // Unter XLS-Dateierweiterung die XLS-Datei abspeichern.
  SD.Filter:= 'Microsoft Excel-Arbeitsmappe (*.xls)|*.XLS';
  SD.DefaultExt:= 'XLS';
  sd.InitialDir := OrdnerVorgabe;
  SD.FileName:= DateiVorgabe;
  if SD.Execute then
  begin
    Result:= SD.FileName;  // Der aktuelle DateiName wird zurückgegeben.
  end;
end;
{------------------------------------------------------------------------------}
procedure TForm1.Button1Click(Sender: TObject);
var
  XLSOrdner: String;
  XLSDateiName: String;
begin
  // Unter XLS-Dateierweiterung die XLS-Datei abspeichern.
  XLSOrdner:= 'F:\Excel-ProgammOrdner\Beispiel Daten';
  XLSDateiName:= 'DelphiDemoXLS.xls';
  XLSDateiName:= XLS_LWPathDateiname(XLSDateiName, XLSOrdner,
                                                           ExcelTabSpeichern);

 // Daten vom StringGrid: Datengitter in eine XLS-Datei speichern.
{++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 DatenInXLSDateiUebertragen(XLSDateiName, DatenGitter);
{++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
end;
{------------------------------------------------------------------------------}
procedure TForm1.FormCreate(Sender: TObject);
begin
  // StringGrid mit Daten füllen
  SpaltenBezInStringGrid(SPALTEN_BEZ, DatenGitter);  // Überschriften in Daten-
                                                     // schreiben.
  Spalte1ZeileSchreiben(SPALTE1_INHALT, DatenGitter);// Erste Spalte ausfüllen.
  Spalte2Bis7Fuellen(ZEILEN_MAX, DatenGitter);       // Zufalls-Zahlen
end;

end.

Bis bald Chemiker

[edit=fkerber]Änderungen von Chemiker für D2009 einfügt. Mfg, fkerber[/edit]