AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Code-Bibliothek Library: Sonstiges Delphi StringGird als XLS-Datei ohne Excel abspeichern

StringGird als XLS-Datei ohne Excel abspeichern

Ein Thema von Chemiker · begonnen am 6. Jul 2007
Antwort Antwort
Benutzerbild von Chemiker
Chemiker

Registriert seit: 14. Aug 2005
1.855 Beiträge
 
Delphi 10.2 Tokyo Professional
 
#1

StringGird als XLS-Datei ohne Excel abspeichern

  Alt 6. Jul 2007, 21:51
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]
wer gesund ist hat 1000 wünsche wer krank ist nur einen.
  Mit Zitat antworten Zitat
Themen-Optionen Thema durchsuchen
Thema durchsuchen:

Erweiterte Suche
Ansicht

Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 21:09 Uhr.
Powered by vBulletin® Copyright ©2000 - 2023, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2021 by Daniel R. Wolf