Registriert seit: 22. Mär 2017
Ort: bei Flensburg
525 Beiträge
FreePascal / Lazarus
|
Excel Stringgrid in (vorhandene) Excel abspeichern
17. Apr 2018, 07:59
Moin zusammen,
ich bin es mal wieder.
Ich hatte mir folgende Routine aus dem Netz geholt und etwas überarbeitet. Ich meine auch das sie bereits funktioniert hat, jetzt ist das Programm allerdings etwas größer geworden und nun funktioniert es nicht mehr (Die Daten werden nicht in Excel übernommen). Hat jemand evtl. eine Idee, denn eigentlich dürfte zusätzlicher Programmcode bei lokalen Variablen ja keinen Einfluss haben.
Wichtig hierbei: Die Exceldatei wird vorher eingelesen (funktioniert mittlerweile 1A) und in eben diese sollen die Daten zurück geschrieben werden beim drücken auf Speichern, da diese im Stringgrid editiert werden (teilweise automatisch).
Code:
//Excel abspeichern (aus Grid)
procedure TTools.SpeichernFClick(Sender: TObject);
var
buttonSelected : Integer;
logf : textfile;
begin
// Show a custom dialog
buttonSelected := messagedlg('Daten in Excel übetragen und Speichern?',mtCustom,
[mbYes,mbCancel], 0);
// Show the button type selected
if buttonSelected = mrYes then
begin
//Grid in Excel & Status anzeigen
HinweisF.Show;
ExcelSheets.Pages[0].Show;
StringgridToXLS(DE_XLS, 'DE', ExcelE.Text);
HinweisF.Caption := 'DE gespeichert';
ExcelSheets.Pages[ExcelSheets.ActivePageIndex + 1].Show;
//...
StringgridToXLS(Listen_XLS, 'Filiallisten', ExcelE.Text);
HinweisF.Caption := 'Filiallisten gespeichert';
ExcelSheets.Pages[ExcelSheets.ActivePageIndex + 1].Show;
StringgridToXLS(CuR_XLS, 'C&R', ExcelE.Text);
HinweisF.Caption := 'Alles gespeichert';
ExcelSheets.Pages[0].Show;
Timer2.Enabled := true;
//Log schreiben
assignfile(logf, ExtractFilePath(ParamStr(0)) + '\Log.txt');
reset(logf);
append(logf);
writeln(logf,DateToStr(Now) + ' - '
+ TimeToStr(Now) + ' - '
+ split(GetCurrentUserName, '.', 0) + ' - '
+ ExcelE.Text + ' - gespeichert');
closefile(logf);
LogList.Items.Clear;
LogList.Items.LoadFromFile(ExtractFilePath(ParamStr(0)) + 'Log.txt');
end;
end;
//Inhalt eines TStringGrid nach Excel exportieren
function TTools.StringgridToXLS(StringGrid : TStringGrid; sheetname : String; AXLSFile : string) : Boolean;
var
Col : Integer;
Data : OleVariant;
XLApp : OleVariant;
MaxCol : Integer;
MaxRow : Integer;
Range : OleVariant;
Row : Integer;
Workbook : OleVariant;
Worksheet : OleVariant;
Value : OleVariant;
begin
Result := False;
//Verbindung zu Excel herstellen
XLApp := CreateOleObject('Excel.Application');
try
if not VarIsNull(XLApp) then
begin
//Workbook öffnen
XLApp.Workbooks.Open(AXLSFile);
XLApp.Visible := false;
if not VarIsNull(Workbook) then
begin
//Maximalen Bereich bestimmen
MaxCol := Min(StringGrid.ColCount, XLApp.Workbooks[ExtractFileName(AXLSFile)].WorkSheets[sheetname].Columns.Count);
MaxRow := Min(StringGrid.RowCount, XLApp.Workbooks[ExtractFileName(AXLSFile)].WorkSheets[sheetname].Rows.Count);
if (MaxRow > 0) and (MaxCol > 0) then
begin
//Worksheet auswählen
Worksheet := XLApp.Workbooks[ExtractFileName(AXLSFile)].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;
XLApp.Quit;
XLAPP := Unassigned;
Value := UnAssigned;
Data := UnAssigned;
Range := UnAssigned;
Workbook := UnAssigned;
end;
end;
end;
//Hilfsfunktionen
function TTools.StringToVariant(const SourceString : string) : Variant;
var
FloatValue : Extended;
begin
if TryStrToFloat(SourceString, FloatValue) then
//Result := FloatValue //außer Kraft gesetzt, da ich (aktuell) nur Strings brauche, auch bei Zahlenwerten wegen führender Null
Result := SourceString
else
Result := SourceString;
end;
Geändert von Moombas (17. Apr 2018 um 09:01 Uhr)
|
|
Zitat
|