AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Thema durchsuchen
Ansicht
Themen-Optionen

Excel speichern

Ein Thema von vesila · begonnen am 11. Jan 2025 · letzter Beitrag vom 16. Jan 2025
 
DaCoda

Registriert seit: 21. Jul 2006
Ort: Hamburg
171 Beiträge
 
Delphi 12 Athens
 
#2

AW: Excel speichern

  Alt 11. Jan 2025, 22:12
Ich habe eine kleine Unit als "Helper" für meine Projekte, wo ich Excel-Sheets brauche.
Da kannst du ja mal schauen ob du da was mit anfangen kannst.

Delphi-Quellcode:
unit tbOfficeUtils;

interface

uses
  Winapi.Windows,
  Winapi.Messages,
  System.SysUtils,
  System.Variants,
  System.Classes,
  Vcl.Graphics,
  Vcl.Controls,
  Vcl.Forms,
  Vcl.Dialogs,
  Vcl.StdCtrls,
  System.Win.ComObj;

const
  xlWBATChart = -4109;
  xlWBATExcel4IntlMacroSheet = 4;
  xlWBATExcel4MacroSheet = 3;
  xlWBATWorksheet = -4167;

type
  TExcelFile = class(TObject)
  private
    FApplication: OLEVariant;
    FWorkBook: OLEVariant;
    FWorkSheet: OLEVariant;
    FVisible: Boolean;
    FDisplayAlerts: Boolean;
    FActWorkSheetIdx: Integer;

    procedure SetVisible(Visible: Boolean);
    procedure SetDisplayAlerts(DisplayAlerts: Boolean);
  public
    constructor Create; virtual;
    destructor Destroy; override;

    function Open: Boolean;
    procedure Close;
    function ExportFile(FileName: TFileName): Boolean;
    function SelectWorkSheet(Index: Integer): Boolean;
    function AddWorkSheet: Integer;

    property Application: OLEVariant read FApplication;
    property WorkBook: OLEVariant read FWorkBook;
    property WorkSheet: OLEVariant read FWorkSheet write FWorkSheet;
    property Visible: Boolean read FVisible write SetVisible;
    property DisplayAlerts: Boolean read FDisplayAlerts write SetDisplayAlerts;
    property ActWorkSheetIdx: Integer read FActWorkSheetIdx;
  end;

implementation

uses
  tbUtils;

constructor TExcelFile.Create;
begin
  inherited Create;
  FApplication := NULL;
  FWorkBook := NULL;
  FWorkSheet := NULL;
  FVisible := False;
  FDisplayAlerts := False;
end;

destructor TExcelFile.Destroy;
begin
  if not VarIsNull(FWorkSheet) then begin
    FWorkSheet := NULL;
  end;

  if not VarIsNull(FWorkBook) then begin
    FApplication.Workbooks.Close;
    FWorkBook := NULL;
  end;

  if not varIsNull(Fapplication) then begin
    FApplication.Quit;
    FApplication := NULL;
  end;
  inherited Destroy;
end;

function TExcelFile.Open: Boolean;
begin
  Result := False;
  try
    FApplication := CreateOleObject('Excel.Application');
    if not VarIsNull(FApplication) then begin
      if not VarIsNull(FApplication) then begin
        FApplication.Visible := FVisible;
        FApplication.DisplayAlerts := FDisplayAlerts;
        try
          FWorkBook := FApplication.WorkBooks.Add(xlWBATWorksheet);
          if not VarIsNull(FWorkBook) then begin
            Result := True;
          end;
        except
          ErrorDialog('Die Arbeitsmappe konnte nicht erzeugt werden!');
          FWorkBook := NULL;
        end;
      end;
    end;
  except
    FApplication := NULL;
    ErrorDialog('Excel konnte nicht geöffnet werden!');
  end;
end;

function TExcelFile.AddWorkSheet: Integer;
begin
  Result := -1;
  if not VarIsNull(WorkBook) then begin
    Workbook.Worksheets.Add(After := Workbook.Worksheets[Workbook.Worksheets.Count]);
    Result := Workbook.Worksheets.Count;
  end;
end;

function TExcelFile.SelectWorkSheet(Index: Integer): Boolean;
begin
  Result := False;
  WorkSheet := WorkBook.Sheets[Index];
  if not VarIsNull(WorkSheet) then begin
    WorkSheet.Activate;
    FActWorkSheetIdx := Index;
    Result := True;
  end;
end;

function TExcelfile.ExportFile(FileName: TFileName): Boolean;
begin
  Result := False;
  if not VarIsNull(FWorkBook) then begin
    try
      SelectWorkSheet(1);
      FWorkbook.SaveAs(FileName);
      Result := True;
    except
      ErrorDialog('Die Arbeitsmappe: ' + QuotedStr(FileName) + ' konnte nicht gespeichert werden!');
    end;
  end;
end;

procedure TExcelFile.Close;
begin
  if not VarIsNull(FWorkSheet) then begin
    FWorkSheet := NULL;
  end;

  if not VarIsNull(FWorkBook) then begin
    FApplication.Workbooks.Close;
    FWorkBook := NULL;
  end;

  if not varIsNull(Fapplication) then begin
    FApplication.Quit;
    FApplication := NULL;
  end;
end;

procedure TExcelfile.SetVisible(Visible: Boolean);
begin
  FVisible := Visible;
end;

procedure TExcelFile.SetDisplayAlerts(DisplayAlerts: Boolean);
begin
  FDisplayAlerts := DisplayAlerts;
end;

end.
Benutzen kann man es Beispielsweise so:

Delphi-Quellcode:
procedure TForm1.btnTestClick(Sender: TObject);
var
  Excel: TExcelFile;
begin
  Excel := TExcelFile.Create;
  try
    with Excel do begin
      Visible := False;
      DisplayAlerts := False;
      if Open then begin
        if SelectWorkSheet(1) then begin
          WorkSheet.Name := 'Erstes Blatt';
          WorkSheet.Columns.Columns[1].ColumnWidth := 150;
          WorkSheet.Cells[1, 1] := 123.456;
          WorkSheet.Cells[1, 1].NumberFormat := '0,00';
          WorkSheet.Cells[2, 1] := 456;
          WorkSheet.Cells[3, 1] := 123;
          WorkSheet.Cells[1, 3] := 'Erstes Blatt';

          WorkSheet.Cells[1, 1].Interior.Color := clRed;
          WorkSheet.Cells[2, 1].Interior.Color := clLime;
          WorkSheet.Cells[3, 1].Interior.Color := clYellow;

          WorkSheet.Cells[1, 1].Font.Name := 'Arial';
          WorkSheet.Cells[1, 1].Font.Size := 20;
          WorkSheet.Cells[1, 1].Font.Bold := True;
          WorkSheet.Cells[1, 1].Font.Color := clYellow;

          WorkSheet.Range['A6', 'A6'].Formula := '=Sum(A1:A3)';

          if AddWorkSheet > -1 then begin;
            if SelectWorkSheet(2) then begin
              Worksheet.Name := 'Zweites Blatt';
              WorkSheet.Cells[1, 5] := 0.815;
              WorkSheet.Cells[1, 5].NumberFormat := '0,00';
              WorkSheet.Cells[1, 5].Font.Name := 'Aial';
              WorkSheet.Cells[1, 5].Font.Size := 6;
              WorkSheet.Cells[1, 5].Font.Bold := True;
              WorkSheet.Cells[1, 5].Font.Color := clRed;

              WorkSheet.Cells[2, 5] := 311264;
              WorkSheet.Cells[3, 5] := 270664;
              WorkSheet.Cells[1, 3] := 'Zweites Blatt';
              WorkSheet.Cells[1, 1].Interior.Color := clMaroon;
              WorkSheet.Cells[2, 1].Interior.Color := clGray;
              WorkSheet.Cells[3, 1].Interior.Color := clWhite;
            end;
          end;
        end;
        ExportFile(System.SysUtils.ExtractFilePath(Vcl.Forms.Application.ExeName) + 'Produktionsberichte.xlsx');
        Close;
      end;
    end;
  finally
    FreeAndNil(Excel);
  end;
end;
Debuggers don’t remove bugs, they only show them in slow-motion.

Geändert von TBx ( 1. Feb 2025 um 09:04 Uhr) Grund: Dode-Tags durch Delphi-Tags ersetzt
  Mit Zitat antworten Zitat
 

 

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:48 Uhr.
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz