AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Programmierung allgemein Programmieren allgemein Delphi Excel Stringgrid in (vorhandene) Excel abspeichern
Thema durchsuchen
Ansicht
Themen-Optionen

Excel Stringgrid in (vorhandene) Excel abspeichern

Ein Thema von Moombas · begonnen am 17. Apr 2018 · letzter Beitrag vom 2. Mai 2018
 
Benutzerbild von Moombas
Moombas

Registriert seit: 22. Mär 2017
Ort: bei Flensburg
525 Beiträge
 
FreePascal / Lazarus
 
#11

AW: Excel Stringgrid in (vorhandene) Excel abspeichern

  Alt 18. Apr 2018, 11:31
Folgendes wäre der aktuell komplette Code, der mit Excel was zu tun hat. Das Problem tritt nur beim Workbook.saveas(AXLSFile, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, False, EmptyParam, EmptyParam, GetUserDefaultLCID); auf, dies scheint bei einer xml somit nicht zu funktionieren, da brauche ich eine Alternative:

Delphi-Quellcode:
unit Toolbox;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ComCtrls, Vcl.Grids, IniFiles,
  Vcl.FileCtrl, shellapi, ComObj, Vcl.ExtCtrls, Math, System.UITypes,
  Vcl.WinXCtrls, directorywatch;

type
  TTools = class(TForm)
   //...
    procedure FormCreate(Sender: TObject);
    procedure AbbrechenClick(Sender: TObject);
    procedure SpeichernEClick(Sender: TObject);
    Procedure FindDirs(DirPath: String; StringList:TStrings; Recurse: Boolean = false);
    procedure ProgramsClick(Sender: TObject);
    Procedure ListFiles(Box : TListbox);
    procedure ProgramsDblClick(Sender: TObject);
    procedure DataDblClick(Sender: TObject);
    function Split(text: string; delimiter: char; p: integer): string;
    procedure ManuellClick(Sender: TObject);
    procedure SuchePBClick(Sender: TObject);
    function CopyDir(SourceDirectory: string; DestinationDirectory: string): boolean;
    procedure KopierenClick(Sender: TObject);
    function Delete(const AFile: string): boolean;
    procedure FertigClick(Sender: TObject);
    function GetCurrentUserName: string;
    function Xls_To_StringGrid(AGrid: TStringGrid; Sheetname : string): Boolean;
    procedure EinlesenFClick(Sender: TObject);
    procedure GridColWidth(grd:TStringGrid;min,max:word);
    procedure SucheFBClick(Sender: TObject);
    procedure XLS_ManuellClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure DE_XLSClick(Sender: TObject);
    procedure SucheFEClick(Sender: TObject);
    procedure SuchePEClick(Sender: TObject);
    function StringgridToXLS(StringGrid : TStringGrid; sheetname : String) : Boolean;
    procedure SpeichernFClick(Sender: TObject);
    procedure SucheFEChange(Sender: TObject);
    procedure SuchePEChange(Sender: TObject);
    function RefToCell(Col, Row : Integer) : string;
    function StringToVariant(const SourceString : string) : Variant;
    function FindStrAndCount(const TargetString, Symbol: String): Integer;
    procedure LogListClick(Sender: TObject);
    procedure FilialenPSClick(Sender: TObject);
    procedure FilialStartChange(Sender: TObject);
    procedure FilialEndeEnter(Sender: TObject);
    procedure FilialStartClick(Sender: TObject);
    procedure NewLog(Path : string);
    procedure Timer3Timer(Sender: TObject);
    function ReportFileTimes(const FileName: string) : TDateTime;
    procedure LogEinlesenClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormDestroy(Sender: TObject);
  private
    { Private-Deklarationen }
    Watch: TDirectoryWatch;
    procedure OnNotify(const Sender: TObject; const Action: TWatchAction; const FileName: string);
  public
    { Public-Deklarationen }
  end;

var
  Tools : TTools;
  FileAction, LogName, LogDatei: String;
  olddate, newdate, FileChange : TDateTime;
  XLApp : OleVariant;

implementation

{$R *.dfm}

//Excel bei Programmende schließen
procedure TTools.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if not VarIsEmpty(XLApp) then
      begin
        XLApp.DisplayAlerts := false;
        XLApp.Quit;
        XLAPP := Unassigned;
      end;
end;

//Grundeinstellungen laden
procedure TTools.FormCreate(Sender: TObject);
var
  Ini: TIniFile;
begin
  Ini:=TIniFile.Create(ExtractFilePath(ParamStr(0)) + '\Settings.ini');
  try
    InstallE.Text := Ini.ReadString('Install', 'Ordner', 'nicht festgelegt!');
    ExcelE.Text := Ini.ReadString('Install', 'Excel', 'nicht festgelegt!');
    OriginalE.Text := Ini.ReadString('Install', 'Originale', 'nicht festgelegt!');
    DataEC.Checked := Ini.ReadBool('Checkbox', 'Daten', False);
    LogEC.Checked := Ini.ReadBool('Checkbox', 'Log', False);
    ErgebnisEC.Checked:= Ini.ReadBool('Checkbox', 'Ergebnis', False);
    ExcelC.Checked := Ini.ReadBool('Checkbox', 'Excel', False);
    FertigEC.Checked := Ini.ReadBool('Checkbox', 'Fertig', False);

    DatenC.Checked := DataEC.Checked;
    LogC.Checked := LogEC.Checked;
    ErgebnisC.Checked := ErgebnisEC.Checked;
    FertigC.Checked := FertigEC.Checked;

    KopierenE.Text := InstallE.Text;
  finally
    Ini.Free;
  end;

  // Create Excel-OLE Object
  XLApp := CreateOleObject('Excel.Application');
  XLApp.Visible := False;
  XLApp.Workbooks.OpenXML(ExcelE.text);

  //Logdatei einlesen
  LogList.Items.LoadFromFile(ExtractFilePath(ParamStr(0)) + 'Log.txt');

  //Programm zum arbeiten vorbereiten
  FindDirs(OriginalE.Text,Programs.Items);
  if ExcelC.Checked = true then EinlesenFClick(Sender);
  ExcelSheets.Pages[0].Show;
  Menu.Pages[1].Show;
end;

//Excel bei Programmabsturz schließen
procedure TTools.FormDestroy(Sender: TObject);
begin
  if not VarIsEmpty(XLApp) then
      begin
        XLApp.DisplayAlerts := false;
        XLApp.Quit;
        XLAPP := Unassigned;
      end;
end;

//Excel in ein Stringgrid übertragen
function TTools.Xls_To_StringGrid(AGrid: TStringGrid; Sheetname : string): Boolean;
const
  xlCellTypeLastCell = $0000000B;
var
  Sheet: OLEVariant;
  RangeMatrix: Variant;
  x, y, k, r: Integer;
begin
  Result := False;
  x := 0;
  y := 0;
  try
    Sheet := XLApp.Workbooks[ExtractFileName(ExcelE.text)].WorkSheets[sheetname];
    // In order to know the dimension of the WorkSheet, i.e the number of rows
    // and the number of columns, we activate the last non-empty cell of it
    XLApp.Workbooks[ExtractFileName(ExcelE.text)].WorkSheets[sheetname].select;
    Sheet.Cells.SpecialCells(xlCellTypeLastCell, EmptyParam).Activate;

    x := XLApp.ActiveCell.Row; // Get the value of the last row
    y := XLApp.ActiveCell.Column; // Get the value of the last column

    // Set Stringgrid's row &col dimensions.
    AGrid.RowCount := x + 4;
    AGrid.ColCount := y;

    RangeMatrix := XLApp.Range['A1', XLApp.Cells.Item[X, Y]].Value; // Assign the Variant associated with the WorkSheet to the Delphi Variant

    // Define the loop for filling in the TStringGrid
    k := 1;
    repeat
      for r := 1 to y do
        AGrid.Cells[(r - 1), (k - 1)] := RangeMatrix[K, R];
      Inc(k, 1);
      AGrid.RowCount := k + 1;
    until k > x;
    // Unassign the Delphi Variant Matrix
    RangeMatrix := Unassigned;

  finally
    // Quit Excel
    if not VarIsEmpty(XLApp) then
    begin
      XLApp.DisplayAlerts := false;
      Sheet := Unassigned;
      Result := True;
    end;
  end;
end;

//Inhalt eines TStringGrid nach Excel exportieren
function TTools.StringgridToXLS(StringGrid : TStringGrid; sheetname : String) : Boolean;
var
  Col : Integer;
  Data : OleVariant;
  MaxCol : Integer;
  MaxRow : Integer;
  Range : OleVariant;
  Row : Integer;
  Workbook : OleVariant;
  Worksheet : OleVariant;
  Value : OleVariant;
begin
  Result := False;
  //Verbindung zu Excel herstellen
  try
    if not VarIsNull(XLApp) then
    begin
      //Workbook öffnen
      XLApp.Workbooks.OpenXML(ExcelE.Text);
      if not VarIsNull(Workbook) then
      begin
        //Maximalen Bereich bestimmen
        MaxCol := Min(StringGrid.ColCount, XLApp.Workbooks[ExtractFileName(ExcelE.Text)].WorkSheets[sheetname].Columns.Count);
        MaxRow := Min(StringGrid.RowCount, XLApp.Workbooks[ExtractFileName(ExcelE.Text)].WorkSheets[sheetname].Rows.Count);
        if (MaxRow > 0) and (MaxCol > 0) then
        begin
          //Worksheet auswählen
          Worksheet := XLApp.Workbooks[ExtractFileName(ExcelE.Text)].WorkSheets[sheetname];
          //Bereich auswählen
          Range := Worksheet.Range[RefToCell(1, 1), RefToCell(MaxCol, MaxRow)];
          if not VarIsNull(Range) then
          begin
            //Daten aus Grid holen
            Data := VarArrayCreate([1, MaxRow, 1, MaxCol], varVariant);
            for Row := 0 to Pred(MaxRow) do
            begin
              for Col := 0 to Pred(MaxCol) do
              begin
                Value := StringToVariant(StringGrid.Cells[Col, Row]);
                Data[Succ(Row), Succ(Col)] := Value
              end;
            end;
            //Daten dem Excelsheet übergeben
            Range.Value := Data;
            Range.Columns.AutoFit;
            Result := True;
          end;
        end;
      end;
    end;
  finally
  if not VarIsEmpty(XLApp) then
    begin
      XLApp.DisplayAlerts := False;
      Workbook.saveas(ExcelE.Text, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, False, EmptyParam, EmptyParam, GetUserDefaultLCID);
      Value := UnAssigned;
      Data := UnAssigned;
      Range := UnAssigned;
      Workbook := UnAssigned;
    end;
  end;
end;
  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 00:30 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