// Exceltabelle füllen
procedure TfmDaten.acExcelExecute(Sender: TObject);
Var
i : Integer;
k : Integer;
l : Integer;
sDirName :
String;
sFileName :
String;
iRecordCount : Integer;
sEMessage :
String;
iErrorCode : Word;
iExcelIndex : Integer;
ea : TExcelApplication;
ewb : TExcelWorkbook;
ews1 : TExcelWorkSheet;
lcid : Integer;
sRange :
String;
sRange2 :
String;
begin
// Schalter für "Excel arbeitet" einschalten.
bExcelActive := True;
// Variabeln für die Verbindung zu Excel initialisieren
ea := TExcelApplication.Create(Self);
ewb := TExcelWorkbook.Create(Self);
ews1 := TExcelWorksheet.Create(Self);
// Verbindungsart zu Excel festlegen.
ea.ConnectKind := ckNewInstance;
ewb.ConnectKind := ckNewInstance;
ews1.ConnectKind := ckNewInstance;
// Diese ID wird zur Komunikation mit Excel benötigt.
lcid := LOCALE_USER_DEFAULT;
Try
// Excel soll unsichtbar arbeiten.
ea.Visible[lcid] := False;
// Comboboxen synchronisieren.
If cbNamen.ItemIndex < 0
Then cbNamen.ItemIndex := cbEMail.ItemIndex
Else If cbEMail.ItemIndex < 0
Then cbEMail.ItemIndex := cbNamen.ItemIndex
Else cbEMail.ItemIndex := cbNamen.ItemIndex;
// Über die MitarbeiterID aus ProgInfo den Dateipfad holen.
fmDataBase.qryDOIT.Close;
fmDataBase.qryDOIT.SQL.Clear;
fmDataBase.qryDOIT.SQL.Text := fmDataBase.fnGetSQL(99);
fmDataBase.qryDOIT.ParamByName('
MITARBEITERID').AsInteger := DatenTabelle.Mitarbeiter.MitarbeiterID;
fmDataBase.fnOpenSQL(fmDataBase.qryDOIT,-1,iRecordCount,sEMessage,iErrorCode,0);
sDirName := fmDataBase.qryDOIT.Fields[0].AsString;
// Dateinamen zusammenbauen.
sFileName := sDirName + '
\Daten.' + Trim(DatenTabelle.Mitarbeiter.
Name) + '
' + IntToStr(DatenTabelle.Mitarbeiter.Jahr) + '
.xls';
// Verbindung zu Excel herstellen.
ea.Connect;
// Falls die Datei schon existiert, müssen wir sie löschen, da wir sonst
// mit ferngesteuertem Excel keine neue Datei erstellen können,
// bzw. Excel zeigt einen Dialog an, zum Überschreiben der Datei oder Speichern
// unter einem anderen Namen, dies ist auch der Fall, wenn die Datei noch offen ist.
If FileExists(sFileName)
Then Begin
If Not DeleteFile(sFileName)
Then Begin
// hier haben wir dann ein Problem
ShowMessage('
Die Excel-Tabelle ' + sFileName + '
ist bereits geöffnet.'
+ #13 + '
Bitte schließen Sie diese Datei in Excel, andernfalls kann das Programm nicht korrekt weiter arbeiten.');
End;
End;
// Neue Arbeitsmappe aufmachen.
ea.Workbooks.Add(EmptyParam,lcid);
// Verbindung zur aktiven Arbeitsmappe herstellen.
ewb.ConnectTo(ea.ActiveWorkbook);
// Verbindung zur ersten Tabelle aufbauen.
ews1.ConnectTo(ea.Worksheets.Item[1]
As _WorkSheet);
// Tabelle aktivieren.
ews1.Activate;
// Der Tabelle einen neuen Namen geben.
ews1.
Name := DatenTabelle.Mitarbeiter.
Name + '
,' + DatenTabelle.Mitarbeiter.Vorname;
// Seitenlayout festlegen
Try
ews1.PageSetup.Orientation := xlLandscape;
// Querformat
ews1.PageSetup.FitToPagesTall := 1;
// Größe automatisch anpassen
ews1.PageSetup.FitToPagesWide := 1;
// Größe automatisch anpassen
ews1.PageSetup.CenterHorizontally := True;
ews1.PageSetup.CenterVertically := True;
ews1.PageSetup.PaperSize := xlPaperA4;
ews1.PageSetup.Zoom := False;
// Kopf- und Fusszeile erstellen
ews1.PageSetup.LeftHeader := '
';
ews1.PageSetup.CenterHeader := '
';
ews1.PageSetup.RightHeader := '
Datum: ' + DateTimeToStr(Now);
ews1.PageSetup.LeftFooter := '
';
ews1.PageSetup.CenterFooter := '
';
ews1.PageSetup.RightFooter := '
Programmversion: ' + fmAbout.lbVersion.Caption + #13 + '
vom: ' + fmAbout.lbDatum.Caption;
Except
// on e : Exception do ShowMessage(e.Message);
End;
// Der linke Index sind die Zeilen, der rechte Index die Spalten.
// Tabelle mit Daten füllen.
// Namen,
ews1.Range['
A3', '
A3'].Value := DatenTabelle.Mitarbeiter.
Name + '
, ' + DatenTabelle.Mitarbeiter.Vorname;
ews1.Range['
A3', '
A3'].Font.FontStyle := '
Fett';
// Mindestumsatz - Text,
ews1.Range['
D4', '
D4'].Value := '
MinU';
ews1.Range['
D4', '
D4'].Font.FontStyle := '
Fett';
// Faktor - Text,
ews1.Range['
A5', '
A5'].Value := '
Faktor';
ews1.Range['
A5', '
A5'].Font.FontStyle := '
Fett';
// Faktor - Zahl,
ews1.Range['
B5', '
B5'].Value := DatenTabelle.Mitarbeiter.Faktor / 100;
ews1.Range['
B5', '
B5'].NumberFormat := '
0,00%';
// Zielumsatz - Text,
ews1.Range['
D5', '
D5'].Value := '
ZielU';
ews1.Range['
D5', '
D5'].Font.FontStyle := '
Fett';
// Quartalsüberschriften
ews1.Range['
D3', '
D3'].Value := '
Quartal';
ews1.Range['
D3', '
D3'].Font.FontStyle := '
Fett';
ews1.Range['
E3', '
E3'].Value := 1;
ews1.Range['
E3', '
E3'].NumberFormat := '
0';
ews1.Range['
E3', '
E3'].Font.FontStyle := '
Fett';
ews1.Range['
F3', '
F3'].Value := 2;
ews1.Range['
F3', '
F3'].NumberFormat := '
0';
ews1.Range['
F3', '
F3'].Font.FontStyle := '
Fett';
ews1.Range['
G3', '
G3'].Value := 3;
ews1.Range['
G3', '
G3'].NumberFormat := '
0';
ews1.Range['
G3', '
G3'].Font.FontStyle := '
Fett';
ews1.Range['
H3', '
H3'].Value := 4;
ews1.Range['
H3', '
H3'].NumberFormat := '
0';
ews1.Range['
H3', '
H3'].Font.FontStyle := '
Fett';
// Mindestumsatz - Zahl,
ews1.Range['
E4', '
E4'].Value := DatenTabelle.Quartal[1].MindestUmsatzDaten;
ews1.Range['
E4', '
E4'].NumberFormat := '
#.###.##0,00';
ews1.Range['
F4', '
F4'].Value := DatenTabelle.Quartal[2].MindestUmsatzDaten;
ews1.Range['
F4', '
F4'].NumberFormat := '
#.###.##0,00';
ews1.Range['
G4', '
G4'].Value := DatenTabelle.Quartal[3].MindestUmsatzDaten;
ews1.Range['
G4', '
G4'].NumberFormat := '
#.###.##0,00';
ews1.Range['
H4', '
H4'].Value := DatenTabelle.Quartal[4].MindestUmsatzDaten;
ews1.Range['
H4', '
H4'].NumberFormat := '
#.###.##0,00';
// Zielumsatz - Zahl.
ews1.Range['
E5', '
E5'].Value := DatenTabelle.Quartal[1].ZielUmsatzDaten;
ews1.Range['
E5', '
E5'].NumberFormat := '
#.###.##0,00';
ews1.Range['
F5', '
F5'].Value := DatenTabelle.Quartal[2].ZielUmsatzDaten;
ews1.Range['
F5', '
F5'].NumberFormat := '
#.###.##0,00';
ews1.Range['
G5', '
G5'].Value := DatenTabelle.Quartal[3].ZielUmsatzDaten;
ews1.Range['
G5', '
G5'].NumberFormat := '
#.###.##0,00';
ews1.Range['
H5', '
H5'].Value := DatenTabelle.Quartal[4].ZielUmsatzDaten;
ews1.Range['
H5', '
H5'].NumberFormat := '
#.###.##0,00';
// Die Zeilen des Stringgrids in die Exceltabelle übernehmen.
// Da wir in der Exceltabelle nicht in der ersten Zeile anfangen, sondern in
// der sechsten, wird auf den Index immer 6 addiert.
iExcelIndex := 6;
l := sgDaten.RowCount;
// sgDaten ist ein Stringgrid.
For i := 0
to l
Do Begin // Einmal für jede Zeile,
For k := 0
to sgDaten.ColCount - 1
Do Begin // einmal für jede Spalte,
If (i = 0)
And (k > sgDaten.ColCount - 3)
Then Continue;
// diese Zeile ignorieren.
If (i = 1)
And (k > sgDaten.ColCount - 3)
Then Continue;
// diese Zeile ignorieren.
If (i = 2)
And (k > sgDaten.ColCount - 3)
Then Continue;
// diese Zeile ignorieren.
If (i = 3)
And (k < sgDaten.ColCount - 2)
Then Continue;
// diese Zeile ignorieren.
// Namen der Zelle erstellen -> k = Spalte -> i = Zeile
sRange := GetExcelRange(k) + IntToStr(i + iExcelIndex);
If ((i < 3)
And (k < sgDaten.ColCount - 2))
Or ((i = 3)
And (k = sgDaten.ColCount - 2))
Or ((k
in [0, sgDaten.ColCount - 2]))
Then Begin
ews1.Range[sRange,sRange].Value := Trim(sgDaten.Cells[k,i]);
End Else Begin
If (i
in [4..7,9..12,14..17,19..22])
Or (i
in [3,8,13,18])
And (k
in [sgDaten.ColCount - 1])
Then Begin
ews1.Range[sRange,sRange].Value := fnStrToExcelFloat(sgDaten.Cells[k,i]);
ews1.Range[sRange,sRange].NumberFormat := '
#.###.##0,00';
End Else
End;
ews1.Range[sRange,sRange].BorderAround(xlContinuous,xlThin,0,0);
End;
// For k := 0 to sgDaten.ColCount - 1 Do Begin // Einmal für jede Spalte.
End;
// Ende For i := 0 to sgDaten.RowCount - 1 do begin.
// Die Formeln für die Spalten "Summe Umsatz" und "Summe Umsatz für Verrechnung"
// müssen erstellt werden.
// Sie kommen in die Zeilen 4, 5, 6, 9, 10, 11, 14, 15, 16, 19, 20 und 21
// der viertletzten und drittletzten Spalte.
// Hier wird berücksichtigt, ob ein Umsatz verrechnungswirksam ist oder nicht.
// Dies erkennt man an der Farbe der fünfletzten Spalte.
// Ist diese clWindow oder clKommentar, dann ist's wirksam, sonst nicht.
k := sgDaten.ColCount - 5;
For i := 4
To 21
Do Begin
If i
in [7,8,12,13,17,18]
Then Continue;
// Diese Zeilen brauchen wir nicht.
// Formeln für die Spalte "Summe Umsatz"
sRange := GetExcelRange(k + 1) + IntToStr(i + iExcelIndex);
ews1.Range[sRange,sRange].Formula := '
=SUM(' + Chr(64 + 5) + IntToStr(i + iExcelIndex)
+ '
:' + GetExcelRange(k - 2) + IntToStr(i + iExcelIndex) + '
)';
// Formeln für die Spalte "Summe Umsatz für Verrechnung"
If (sgDaten.ColorCell[k,i] <> clKommentar)
And (sgDaten.ColorCell[k,i] <> clWindow)
Then Begin
// Umsätze sind nicht verrechnungswirksam.
// Wenn kein Anspruch besteht schreiben wir keine Formel, sondern den Wert 0.
sRange := GetExcelRange(k + 4) + IntToStr(i + iExcelIndex);
ews1.Range[sRange,sRange].Value := 0;
// Entsprechenden Kommentar in die Tabelle schreiben.
sRange := GetExcelRange(sgDaten.ColCount + 1) + IntToStr(i + iExcelIndex);
ews1.Range[sRange,sRange].Value := '
nicht verrechnungswirksam';
ews1.Range[sRange,sRange].Font.FontStyle := '
Fett';
ews1.Range[sRange,sRange].Font.Size := 10;
ews1.Range[sRange,sRange].Font.ColorIndex := 3;
End Else Begin
sRange := GetExcelRange(k + 2) + IntToStr(i + iExcelIndex);
ews1.Range[sRange,sRange].Formula := '
=' + Chr(64 + 4) + IntToStr(i + iExcelIndex)
+ '
+' + GetExcelRange(k + 1) + IntToStr(i + iExcelIndex);
End;
End;
// Jetzt müssen wir die Formeln für die Gesamtzeilen erstellen.
// Diese kommen in die Zeilen 7, 12, 17 und 22.
// Die Summen müssen für die Spalten 1 bis ColCount - 3 erstellt werden.
i := 7;
Repeat
For k := 1
To sgDaten.ColCount - 3
Do Begin
sRange := GetExcelRange(k) + IntToStr(i + iExcelIndex);
ews1.Range[sRange,sRange].Formula := '
=SUM(' + GetExcelRange(k) + IntToStr(i - 3 + iExcelIndex)
+ '
:' + GetExcelRange(k) + IntToStr(i - 1 + iExcelIndex) + '
)';
End;
i := i + 5;
Until i > 22;
// Nun muß der Anspruch für das Quartal berechnet werden.
// Der Anspruch steht in den Zeilen 4, 9, 14 und 19 in der letzten Spalte.
i := 4;
k := sgDaten.ColCount - 1;
sRange2 := GetExcelRange(k - 2);
// Spaltenbuchstabe der Summe für die Verrechnungsberechnung.
sRange := GetExcelRange(k) + IntToStr(i + iExcelIndex);
ews1.Range[sRange,sRange].Formula := '
=If(' + sRange2 + '
13>E4,(' + sRange2 + '
13-E4)*B5,0)';
i := 9;
sRange := GetExcelRange(k) + IntToStr(i + iExcelIndex);
ews1.Range[sRange,sRange].Formula := '
=If(' + sRange2 + '
18>F4,(' + sRange2 + '
18-F4)*B5,0)';
i := 14;
sRange := GetExcelRange(k) + IntToStr(i + iExcelIndex);
ews1.Range[sRange,sRange].Formula := '
=If(' + sRange2 + '
23>G4,(' + sRange2 + '
23-G4)*B5,0)';
i := 19;
sRange := GetExcelRange(k) + IntToStr(i + iExcelIndex);
ews1.Range[sRange,sRange].Formula := '
=If(' + sRange2 + '
28>H4,(' + sRange2 + '
28-H4)*B5,0)';
// Jetzt werden die Vorauszahlungen aus den Gesamtzeilen übernommen.
// Sie kommen in die Zeilen 5, 10, 15 und 20 in der letzten Spalte.
i := 5;
Repeat
sRange := GetExcelRange(k) + IntToStr(i + iExcelIndex);
ews1.Range[sRange,sRange].Formula := '
=' + GetExcelRange(k - 4) + IntToStr(i + 2 + iExcelIndex);
i := i + 5;
Until i > 20;
// Die Abschlagszahlungen müssen ebenfalls aus den Gesamtzeilen übernommen werden.
// Sie kommen in die Zeilen 6, 11, 16, und 21 der letzten Spalte.
i := 6;
Repeat
sRange := GetExcelRange(k) + IntToStr(i + iExcelIndex);
ews1.Range[sRange,sRange].Formula := '
=' + GetExcelRange(k - 5) + IntToStr(i + 1 + iExcelIndex);
i := i + 5;
Until i > 21;
// Nun benötigen wir noch die Restansprüche.
// Sie stehen in den Zeilen 7, 12, 17 und 22 der letzten Spalte
// und werden aus den vier davor stehenden Zeilen berechnet.
i := 7;
Repeat
sRange := GetExcelRange(k) + IntToStr(i + iExcelIndex);
ews1.Range[sRange,sRange].Formula := '
=' + GetExcelRange(k) + IntToStr(i - 4 + iExcelIndex)
+ '
+' + GetExcelRange(k) + IntToStr(i - 3 + iExcelIndex)
+ '
-' + GetExcelRange(k) + IntToStr(i - 2 + iExcelIndex)
+ '
-' + GetExcelRange(k) + IntToStr(i - 1 + iExcelIndex);
i := i + 5;
Until i > 22;
// Jetzt brauchen wir noch die Quartalsüberträge. Diese werden aus der
// vorhergehenden Zeile übernommen und zwar in die Zeilen 8, 13 und 18;
i := 8;
Repeat
sRange := GetExcelRange(k) + IntToStr(i + iExcelIndex);
ews1.Range[sRange,sRange].Formula := '
=' + GetExcelRange(k) + IntToStr(i - 1 + iExcelIndex);
i := i + 5;
Until i > 18;
// Damit das Ganze jetzt noch ein bisserl Farbe bekommt:
// Die Zeilen 0 bis 2, 7, 12, 17 und 22 werden grau hinterlegt und fett.
For i := 0
To 22
Do Begin
If i
in [0..2,7,12,17,22]
Then Begin
For k := 0
To sgDaten.ColCount - 1
Do Begin
sRange := GetExcelRange(k) + IntToStr(i + iExcelIndex);
ews1.Range[sRange,sRange].Font.FontStyle := '
Fett';
ews1.Range[sRange,sRange].Interior.ColorIndex := 15;
ews1.Range[sRange,sRange].Interior.Pattern := xlSolid;
ews1.Range[sRange,sRange].BorderAround(xlContinuous,xlThin,0,0);
End;
End;
End;
// Spaltenbreite auf optimale Breite bringen.
ews1.Cells.Select;
ews1.Cells.EntireColumn.AutoFit;
// Cursor positionieren.
ews1.Range['
A1','
A1'].Select;
Try
// Gibts die Datei schon, dann löschen.
If FileExists(sFileName)
Then DeleteFile(sFileName);
// Exceldatei speichern.
ewb.SaveAs(sFilename,xlNormal,'
','
',False,False,xlNoChange,xlLocalSessionChanges,False,'
','
',lcid);
Except
// Wenn's Speichern der Exceltabelle schief ging,
// die Tabelle ist in Excel geöffnet und kann vom Anwender
// manuell gespeichert werden.
On E :
Exception Do Begin
MessageDlg('
Fehler beim Speichern der Excel-Tabelle ' + sFileName + '
.'
+ #13 + e.
Message,mtError,[mbok],0);
// Excel soll sichtbar arbeiten.
ea.Visible[lcid] := True;
End;
End;
Try
// Workbook schließen
// Excel fragt nach, ob Änderungen gespeichert werden sollen
ea.Workbooks.Close(lcid);
ea.Quit;
Except
On E :
Exception Do Begin
MessageDlg('
Fehler beim Schließen der Excel-Tabelle ' + sFileName + '
.'
+ #13 + e.
Message,mtError,[mbok],0);
// Excel soll sichtbar arbeiten.
ea.Visible[lcid] := True;
End;
End;
Finally
// Verbindung zu Excel trennen.
ews1.Disconnect;
ewb.Disconnect;
ea.Disconnect;
ews1.Free;
ewb.Free;
ea.Free;
End;
// Uns selbst in den Vordergrund bringen.
BringToFront;
// Schalter für "Excel arbeitet" ausschalten.
bExcelActive := False;
end;
// Excel benötigt anstelle von Punkten Kommas und an Stelle von Kommas Punkte.
Function fnStrToExcelFloat(sInput :
String) :
String;
Var
f : Extended;
s :
String;
Begin
sInput := Trim(sInput);
While Pos('
.',sInput) <> 0
Do Delete(sInput,Pos('
.',sInput),1);
If (sInput <> '
')
Then Begin
Try
f := StrToFloat(sInput);
s := FloatToStr(f);
If Pos('
,',s) <> 0
Then While Pos('
,',s) <> 0
Do s[Pos('
,',s)] := '
.';
Result := s;
Except
On e :
Exception Do Begin
MessageDlg('
Ungültige Eingabe' + #13 + e.
Message,mtError,[mbok],0);
Result := '
0';
End;
End;
End Else Result := '
0';
End;
function GetExcelRange(iColumn : Integer) :
String;
begin
Case iColumn
Of
0..25 : Result := Chr(64 + iColumn + 1);
else
begin
Result := Chr(64 + (iColumn
DIV 26)) + Chr(64 + (iColumn
MOD 26) + 1);
end;
end;
end;