Thema: Delphi Excel speichern

Einzelnen Beitrag anzeigen

DaCoda

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

AW: Excel speichern

  Alt 11. Jan 2025, 23: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.

Code:
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:

Code:
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.
  Mit Zitat antworten Zitat