Autor Beitrag
D. Annies
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starontopic star
Beiträge: 1843

windows 7
D6 Enterprise, D7 Pers und TD 2006
BeitragVerfasst: Sa 12.04.08 21:22 
Hi, Delpher,

(wie) kann man diese Lösung noch verbessern? Ich habe den Eindruck, dass vor allem die drei Procs am Ende noch ordentlich vereinfacht werden können, da sie sehr ähnlich aussehen.

Es geht also um Tuning - bei gleicher Funktionalität. Wer kann da helfen?

ausblenden volle Höhe Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
procedure TForm1.excelstart(sender:Tobject);
var erg : integer;
begin
  exneu := false; // Datei ist vorhanden!
  erg := MessageDlgpos(fname+#13+
            'Datei ist vorhanden -> ansehen  oder  löschen (und überschreiben)? ' + #13 +
            ' ja = vorhandene Datei ansehen,  nein = löschen/neu anlegen',
                   mtConfirmation, [mbYes, mbNo], 0,200,475);
  case erg of
    mryes:
    begin
      excel.workbooks.open(fname);   
      showmessage(Excel.workbooks[1].worksheets[1].UsedRange.rows.count);
    end;
    mrno:
    begin      
      deletefile(fname); showmessage(fname+ ' wurde gelöscht');
      exneu := true;      //Excel.DisplayAlerts := False;
    end;
  end
end;

procedure TForm1.Excel_Layout(sender:Tobject);
var erg  : integer;
begin
  excel.workbooks.add;                  
  hnam := fname; hnam := extractFilename(hnam); delete(hnam, length(hnam)-34);
  excel.workbooks[1].worksheets[1].name := hnam;

  erg := xmessagedlg(fname+#13'Neue Datei, Excel im Querformat ODER im Hochformat starten?',
           mtConfirmation, [mbYes, mbno, mbcancel], ['Quer''Hoch''Abbrechen'], self.font);
  case erg of
    mryes    : excel.activesheet.pagesetup.orientation := 2;  // Querformat
    mrno     : excel.activesheet.pagesetup.orientation := 1;  // Hochformat
    mrcancel : begin Excel := unassigned; exit; end;
  end;
end;

procedure TForm1.Excel2Click(Sender: TObject);                          //popup6
begin
  try
    Excel := CreateOleObject('Excel.Application');
  except
    ShowMessage('Excel kann nicht gestartet werden!');
    Exit;
  end;
  fname := concat(label30.caption, 'OUTXLS\Liste der Lehrkräfte.xls');
  if fileexists(fname) then  excelstart(self);    //löschen/überschreiben?
  if not fileexists(fname) or exneu then
  begin
    Excel_Layout(self);
    Qx2Excel(Dbgrid6, QLk);                 //Excel(0/0) = [1,0]; Zeile/Spalte!
    excel.activeworkbook.saveas(fname);
  end;
  excel.visible := true;
end;

procedure TForm1.Excel4Click(Sender: TObject);                          //popup5
begin
  try
    Excel := CreateOleObject('Excel.Application');
  except
    ShowMessage('Excel kann nicht gestartet werden!');
    Exit;
  end;
  fname := concat(label30.caption, 'OUTXLS\Schülerliste_'+hnam+ '.xls');
  if fileexists(fname) then  excelstart(self);
  if not fileexists(fname) or exneu then
  begin
    Excel_Layout(self);
    Qx2Excel(Dbgrid1, QSchueler);
    excel.activeworkbook.saveas(fname);
  end;
  excel.visible := true;
end;

procedure TForm1.Excel5Click(Sender: TObject);                          //popup8
begin
  try
    Excel := CreateOleObject('Excel.Application');
  except
    ShowMessage('Excel kann nicht gestartet werden!');
    Exit;
  end;
  fname := concat(label30.caption, 'OUTXLS\Buchstammliste.xls');
  if fileexists(fname) then  excelstart(self);
  if not fileexists(fname) or exneu then
  begin
    Excel_Layout(self);
    Qx2Excel(Dbgrid4, QBuchstamm);
    excel.activeworkbook.saveas(fname);
  end;
  excel.visible := true;
end;


Vielen Dank für eure aufgewendete Mühe - noch Fragen?
Ansonsten hilft der Code vielleicht auch Leuten, die Excel einsetzen wollen (nicht so "kompliziert", wie hier, nur wegen der verwendeten Kommandos)

Gruß, Detlef

P.S. Mittlerweile bin ich viele Schritte weiter, werde die neue Lösung morgen/übermorgen einstellen.

_________________
ut vires desint, tamen est laudanda voluntas
D. Annies Threadstarter
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starontopic star
Beiträge: 1843

windows 7
D6 Enterprise, D7 Pers und TD 2006
BeitragVerfasst: Di 15.04.08 21:20 
Leider gab es keine Antworten / Interesse. Meine Änderungen werden dann wohl auch zu individuell sein.
Denn ziehe ich meine Frage mal zurück.

Viele Grüße,
Detlef

_________________
ut vires desint, tamen est laudanda voluntas