Einzelnen Beitrag anzeigen

Benutzerbild von Moombas
Moombas

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

Arbeiten mit Excel generiert *.tmp

  Alt 24. Mär 2017, 08:54
Da mein eigentliches Thema "Rahmen in Excel zeichnen" erledigt ist, mache ich für ein neues gravierendes Problem ein neues Thema auf:

Er generiert zur Laufzeit teilweise ettliche *tmp Dateien und ich finde die Ursache nicht, Vermute sie aber im Zusammenhang mit Excel, denn früher hatte ich solche Probleme nie (habe da nicht direkt mit einem externen Programm gearbeitet). Vielleicht hat jemand von euch eine Idee, falls das ganze Programm benötigt wird bescheid geben dann müsste ich mal schauen wegen Betriebsbezogener Daten:

Delphi-Quellcode:
//Excel einlesen
function Xls_To_StringGrid(AGrid: TStringGrid; AXLSFile: string): Boolean;
const
  xlCellTypeLastCell = $0000000B;
var
  XLApp, Sheet: OLEVariant;
  RangeMatrix: Variant;
  x, y, k, r: Integer;
begin
  Result := False;
  // Create Excel-OLE Object
  XLApp := CreateOleObject('Excel.Application');
  try
    // Hide Excel
    XLApp.Visible := False;
    // Open the Workbook
    XLApp.Workbooks.Open(AXLSFile);
    // Sheet := XLApp.Workbooks[1].WorkSheets[1];
    Sheet := XLApp.Workbooks[ExtractFileName(AXLSFile)].WorkSheets[1];
    // 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
    Sheet.Cells.SpecialCells(xlCellTypeLastCell, EmptyParam).Activate;
    // Get the value of the last row
    x := XLApp.ActiveCell.Row;
    // Get the value of the last column
    y := XLApp.ActiveCell.Column;
    // Set Stringgrid's row &col dimensions.
    AGrid.RowCount := x;
    AGrid.ColCount := y;
    // Assign the Variant associated with the WorkSheet to the Delphi Variant
    RangeMatrix := XLApp.Range['A1', XLApp.Cells.Item[X, Y]].Value;
    // 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;
      XLApp.Quit;
      XLAPP := Unassigned;
      Sheet := Unassigned;
      Result := True;
    end;
  end;
end;
//Excel einfärben
procedure TMAin.Xls_To_Color(AXLSFile: string; Zeile : integer; Farbe : string; Text : integer);
const
  xlCellTypeLastCell = $0000000B;
var
  Excel, Sheet: OLEVariant;
  Puffer : string;
  Color : integer;
begin
  deletefile('C:\Users\' + login + '\Documents\RESUME.XLW');
  if farbe = 'Weißthen Color := 0;
  if farbe = 'Rot'  then Color := 3;
  if farbe = 'Grünthen Color := 10;
  if farbe = 'Blauthen Color := 41;
  if farbe = 'Gelbthen Color := 6;
  // Create Excel-OLE Object
  Excel := CreateOleObject('Excel.Application');
  try
    // Hide Excel
    Excel.Visible := False;
    // Open the Workbook
    Excel.Workbooks.Open(AXLSFile);
    // Sheet := XLApp.Workbooks[1].WorkSheets[1];
    Sheet := Excel.Workbooks[ExtractFileName(AXLSFile)].WorkSheets[1];

    Puffer := inttostr(Zeile+1)+':'+inttostr(Zeile+1);
    if text = 1 then Excel.Selection.Range[Puffer].colorindex := Color else Excel.Range[Puffer].Interior.ColorIndex := Color;
  finally
    // Save file and Quit Excel
    if not VarIsEmpty(Excel) then
    begin
      Excel.save;
      Excel.Quit;
      Excel := Unassigned;
      Sheet := Unassigned;
    end;
  end;
end;
//Excel Raster zeichnen
procedure TMAin.Xls_Grid(AXLSFile: string);
const
  xlCellTypeLastCell = $0000000B;
var
  Excel, Sheet: OLEVariant;
  Puffer : string;
begin
  deletefile('C:\Users\' + login + '\Documents\RESUME.XLW');
  // Create Excel-OLE Object
  Excel := CreateOleObject('Excel.Application');
  try
    // Hide Excel
    Excel.Visible := False;
    // Open the Workbook
    Excel.Workbooks.Open(AXLSFile);
    // Sheet := XLApp.Workbooks[1].WorkSheets[1];
    Sheet := Excel.Workbooks[ExtractFileName(AXLSFile)].WorkSheets[1];

    // Oberste Zeile Fett und Grau
    Excel.Range[inttostr(1)+':'+inttostr(1)].Font.FontStyle := 'Bold';
    Excel.Range[inttostr(1)+':'+inttostr(1)].Interior.ColorIndex := 15 ;
    //Rahmen zeichnen
    Puffer := '1:'+ inttostr(Display.RowCount - 1);
    Excel.Range[Puffer].Borders[11].LineStyle := 1;
    Excel.Range[Puffer].Borders[11].Weight := 2;
    Excel.Range[Puffer].Borders[12].LineStyle := 1;
    Excel.Range[Puffer].Borders[12].Weight := 2;
    Excel.Range[inttostr(1)+':'+inttostr(1)].BorderAround(11,3,0,0);
  finally
    // Save file and Quit Excel
    if not VarIsEmpty(Excel) then
    begin
      Excel.save;
      Excel.Quit;
      Excel := Unassigned;
      Sheet := Unassigned;
    end;
  end;
end;
oder hier:

Delphi-Quellcode:
  try
  deletefile('C:\Users\' + login + '\Documents\RESUME.XLW');
  {create variant array where we'll copy our data}
  RowCount := Display.RowCount;
  ColCount := Display.ColCount;
  arrData := VarArrayCreate([1, RowCount, 1, ColCount], varVariant);
  {fill array}
  for i := 1 to RowCount do
    for j := 1 to ColCount do
      arrData[i, j] := Display.Cells[j-1, i-1];
  {initialize an instance of Excel}
  xls := CreateOLEObject('Excel.Application');
  {create workbook}
  wb := xls.Workbooks.Add;
  {retrieve a range where data must be placed}
  Range := wb.WorkSheets[1].Range[wb.WorkSheets[1].Cells[1, 1], wb.WorkSheets[1].Cells[RowCount, ColCount]];
  {copy data from allocated variant array}
  Range.Value := arrData;
  {show Excel with our data}
  xls.Visible := False;
  deletefile(neuedatei);
  xls.Range['A1', 'ZZ9999'].EntireColumn.Autofit;
  xls.Application.Workbooks[1].SaveAs(neuedatei);
  finally
    // Save file and Quit Excel
  if not VarIsEmpty(xls) then
    begin
      xls.save;
      xls.Quit;
      xls := Unassigned;
      wb := Unassigned;
    end;
  end;
Bisher behelfe ich mir mit folgendem, was aber eher ein Workaround ist und weniger eine "Lösung":

Delphi-Quellcode:
  //tempdateien löschen
  for i := 0 to 25 do
  begin
    FindFirst('C:\Users\' + Login + '\Desktop\*.tmp', faAnyFile, SearchRec);
    if FileExists('C:\Users\' + Login + '\Desktop\' + SearchRec.name) = true then
    begin
      showmessage(SearchRec.Name);
      deletefile('C:\Users\' + Login+ '\Desktop\' + SearchRec.Name)
    end
    else
     FindClose(SearchRec);
  end;
  Mit Zitat antworten Zitat