|
Registriert seit: 22. Mär 2017 Ort: bei Flensburg 525 Beiträge FreePascal / Lazarus |
#11
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; |
![]() |
Ansicht |
![]() |
![]() |
![]() |
ForumregelnEs 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
|
|
Nützliche Links |
Heutige Beiträge |
Sitemap |
Suchen |
Code-Library |
Wer ist online |
Alle Foren als gelesen markieren |
Gehe zu... |
LinkBack |
![]() |
![]() |