//Bestimmen des SelectRange für zweite Tabelle
function RefToCell(RowID, ColID: Integer):
string;
var
ACount, APos: Integer;
begin
ACount := ColID
div 26;
APos := ColID
mod 26;
if APos = 0
then
begin
ACount := ACount - 1;
APos := 26;
end;
if ACount = 0
then
Result := Chr(Ord('
A') + ColID - 1) + IntToStr(RowID+4);
if ACount = 1
then
Result := '
A' + Chr(Ord('
A') + APos - 1) + IntToStr(RowID+4);
if ACount > 1
then
Result := Chr(Ord('
A') + ACount - 1) + Chr(Ord('
A') + APos - 1) +
IntToStr(RowID+4);
end;
//Bestimmen des SelectRange für Tabellentext
function RefToCell2(RowID, ColID: Integer):
string;
var
ACount, APos: Integer;
begin
ACount := ColID
div 26;
APos := ColID
mod 26;
if APos = 0
then
begin
ACount := ACount - 1;
APos := 26;
end;
if ACount = 0
then
Result := Chr(Ord('
A') + ColID - 1) + IntToStr(RowID);
if ACount = 1
then
Result := '
A' + Chr(Ord('
A') + APos - 1) + IntToStr(RowID);
if ACount > 1
then
Result := Chr(Ord('
A') + ACount - 1) + Chr(Ord('
A') + APos - 1) +
IntToStr(RowID);
end;
//StringGrid-Inhalt nach Excel exportieren
function StringGridToExcelSheetV(Grid: TStringGrid; SheetName, FileName:
string;
ShowExcel: Boolean): Boolean;
const
xlWBATWorksheet = -4167;
var
SheetCount, SheetColCount, SheetRowCount, BookCount: Integer;
XLApp, Sheet, Data: OLEVariant; SelRange: OLEVariant;
I, J, N, M: Integer;
SaveFileName :
string;
begin
//notwendige Sheetanzahl feststellen
SheetCount := (Grid.ColCount
div 256) + 1;
if Grid.ColCount
mod 256 = 0
then
SheetCount := SheetCount - 1;
//notwendige Bookanzahl feststellen
BookCount := (Grid.RowCount
div 65536) + 1;
if Grid.RowCount
mod 65536 = 0
then
BookCount := BookCount - 1;
//Create Excel-OLE Object
Result := False;
XLApp := CreateOleObject('
Excel.Application');
try
//Excelsheet anzeigen
if ShowExcel = false
then
XLApp.Visible := False
else
XLApp.Visible := True;
//Workbook hinzufügen
for M := 1
to BookCount
do
begin
XLApp.Workbooks.Add(xlWBATWorksheet);
//Sheets anlegen
for N := 1
to SheetCount - 1
do
begin
XLApp.Worksheets.Add;
end;
end;
//Sheet ColAnzahl feststellen
if Grid.ColCount <= 256
then
SheetColCount := Grid.ColCount
else
SheetColCount := 256;
//Sheet RowAnzahl feststellen
if Grid.RowCount <= 65536
then
SheetRowCount := Grid.RowCount+9
else
SheetRowCount := 65536;
//Sheets befüllen
for M := 1
to BookCount
do
begin
for N := 1
to SheetCount
do
begin
//Daten aus Grid holen
Data := VarArrayCreate([1, Grid.RowCount+9, 1, SheetColCount], varVariant);
for I := 0
to SheetColCount - 1
do
for J := 0
to SheetRowCount -9
do
if ((I+256*(N-1)) <= Grid.ColCount)
and ((J+65536*(M-1)) <= Grid.RowCount)
then
Data[J + 5, I + 1] := Grid.Cells[I+256*(N-1), J+65536*(M-1)];
Data[1,1] := KF.ueber;
Data[3,1] := form1.EKFStand.text;
Data[sheetrowcount-3,1]:='
Ferien: Ostern: '+KF.ostern+'
; Sommer: '+KF.sommer;
Data[sheetrowcount-2,1]:='
Herbst: '+KF.herbst+'
; Weihnachten: '+KF.weihnachten;
Data[sheetrowcount,1]:='
Sonstiges: '+KF.sonstiges;
XLApp.Worksheets[N].Select;
XLApp.Workbooks[M].Worksheets[N].
Name := SheetName + IntToStr(N);
//Zellen als String Formatieren
SelRange := XLApp.Workbooks[M].Worksheets[N].Range[RefToCell2(1, 1), RefToCell2(SheetRowCount, SheetColCount)];
SelRange.Select;
XLApp.Selection.NumberFormat := '
@';
XLApp.Workbooks[M].Worksheets[N].Range['
A1'].Select;
XLApp.Range['
A1','
G1'].Borders[xlDiagonalDown].LineStyle := xlNone;
XLApp.Range['
A1','
G1'].Borders[xlDiagonalUp].LineStyle := xlNone ;
XLApp.Range['
A1','
G1'].Borders[xlEdgeLeft].LineStyle := xlContinuous;
XLApp.Range['
A1','
G1'].Borders[xlEdgeLeft].Weight := xlThin;
XLApp.Range['
A1','
G1'].Borders[xlEdgeLeft].ColorIndex := xlAutomatic;
XLApp.Range['
A1','
G1'].Borders[xlEdgeTop].LineStyle := xlContinuous;
XLApp.Range['
A1','
G1'].Borders[xlEdgeTop].Weight := xlThin;
XLApp.Range['
A1','
G1'].Borders[xlEdgeTop].ColorIndex := xlAutomatic;
XLApp.Range['
A1','
G1'].Borders[xlEdgeBottom].LineStyle := xlContinuous;
XLApp.Range['
A1','
G1'].Borders[xlEdgeBottom].Weight := xlThin;
XLApp.Range['
A1','
G1'].Borders[xlEdgeBottom].ColorIndex := xlAutomatic;
XLApp.Range['
A1','
G1'].Borders[xlEdgeRight].LineStyle := xlContinuous;
XLApp.Range['
A1','
G1'].Borders[xlEdgeRight].Weight := xlThin;
XLApp.Range['
A1','
G1'].Borders[xlEdgeRight].ColorIndex := xlAutomatic;
XLApp.Range['
A1','
G1'].Borders[xlInsideVertical].LineStyle := xlContinuous;
XLApp.Range['
A1','
G1'].Borders[xlInsideVertical].Weight := xlThin;
XLApp.Range['
A1','
G1'].Borders[xlInsideVertical].ColorIndex := xlAutomatic;
XLApp.Range['
A1','
G1'].Borders[xlInsideHorizontal].LineStyle := xlContinuous;
XLApp.Range['
A1','
G1'].Borders[xlInsideHorizontal].Weight := xlThin;
XLApp.Range['
A1','
G1'].Borders[xlInsideHorizontal].ColorIndex := xlAutomatic;
sheetrowcount:=sheetrowcount-9;
XLApp.Range[RefToCell(1, 1), RefToCell(SheetRowCount,SheetColCount)].Borders[xlDiagonalDown].LineStyle := xlNone;
XLApp.Range[RefToCell(1, 1), RefToCell(SheetRowCount,SheetColCount)].Borders[xlDiagonalUp].LineStyle := xlNone ;
XLApp.Range[RefToCell(1, 1), RefToCell(SheetRowCount,SheetColCount)].Borders[xlEdgeLeft].LineStyle := xlContinuous;
XLApp.Range[RefToCell(1, 1), RefToCell(SheetRowCount,SheetColCount)].Borders[xlEdgeLeft].Weight := xlThin;
XLApp.Range[RefToCell(1, 1), RefToCell(SheetRowCount,SheetColCount)].Borders[xlEdgeLeft].ColorIndex := xlAutomatic;
XLApp.Range[RefToCell(1, 1), RefToCell(SheetRowCount,SheetColCount)].Borders[xlEdgeTop].LineStyle := xlContinuous;
XLApp.Range[RefToCell(1, 1), RefToCell(SheetRowCount,SheetColCount)].Borders[xlEdgeTop].Weight := xlThin;
XLApp.Range[RefToCell(1, 1), RefToCell(SheetRowCount,SheetColCount)].Borders[xlEdgeTop].ColorIndex := xlAutomatic;
XLApp.Range[RefToCell(1, 1), RefToCell(SheetRowCount,SheetColCount)].Borders[xlEdgeBottom].LineStyle := xlContinuous;
XLApp.Range[RefToCell(1, 1), RefToCell(SheetRowCount,SheetColCount)].Borders[xlEdgeBottom].Weight := xlThin;
XLApp.Range[RefToCell(1, 1), RefToCell(SheetRowCount,SheetColCount)].Borders[xlEdgeBottom].ColorIndex := xlAutomatic;
XLApp.Range[RefToCell(1, 1), RefToCell(SheetRowCount,SheetColCount)].Borders[xlEdgeRight].LineStyle := xlContinuous;
XLApp.Range[RefToCell(1, 1), RefToCell(SheetRowCount,SheetColCount)].Borders[xlEdgeRight].Weight := xlThin;
XLApp.Range[RefToCell(1, 1), RefToCell(SheetRowCount,SheetColCount)].Borders[xlEdgeRight].ColorIndex := xlAutomatic;
XLApp.Range[RefToCell(1, 1), RefToCell(SheetRowCount,SheetColCount)].Borders[xlInsideVertical].LineStyle := xlContinuous;
XLApp.Range[RefToCell(1, 1), RefToCell(SheetRowCount,SheetColCount)].Borders[xlInsideVertical].Weight := xlThin;
XLApp.Range[RefToCell(1, 1), RefToCell(SheetRowCount,SheetColCount)].Borders[xlInsideVertical].ColorIndex := xlAutomatic;
XLApp.Range[RefToCell(1, 1), RefToCell(SheetRowCount,SheetColCount)].Borders[xlInsideHorizontal].LineStyle := xlContinuous;
XLApp.Range[RefToCell(1, 1), RefToCell(SheetRowCount,SheetColCount)].Borders[xlInsideHorizontal].Weight := xlThin;
XLApp.Range[RefToCell(1, 1), RefToCell(SheetRowCount,SheetColCount)].Borders[xlInsideHorizontal].ColorIndex := xlAutomatic;
XLApp.Range['
A5','
G5'].Font.Bold:=true;
XLApp.Range['
A1','
G1'].Interior.color:=clGray;
XLApp.Range['
A1','
G1'].Font.Bold:=true;
XLApp.Range['
A1','
G1'].Font.size:=13;
XLApp.Range['
A1','
G1'].rowheight:=25;
XLApp.Range['
A5','
G5'].rowheight:=25;
XLApp.Range['
A5','
G5'].Interior.color:=clGray;
XLApp.Range['
A5','
G5'].HorizontalAlignment := xlHAligncenter;
XLApp.Range['
A5','
G5'].VerticalAlignment := xlVAligncenter;
XLApp.Range['
A1','
G1'].HorizontalAlignment := xlHAligncenter;
XLApp.Range['
A1','
G1'].VerticalAlignment := xlVAligncenter;
XLApp.Range['
A1','
G1'].MergeCells := true;
sheetrowcount:=sheetrowcount+9;
//Daten dem Excelsheet übergeben
Sheet := XLApp.Workbooks[M].WorkSheets[N];
Sheet.Range[RefToCell2(1, 1), RefToCell2(SheetRowCount,SheetColCount)].Value := Data;
sheetrowcount:=sheetrowcount-9;
SelRange := XLApp.Workbooks[M].Worksheets[N].Range[RefToCell(1, 1), RefToCell(SheetRowCount, SheetColCount)];
sheetrowcount:=sheetrowcount+9;
SelRange.Select;
XLApp.Selection.Columns.AutoFit;
end;
end;
//Save Excel Worksheet
try
for M := 1
to BookCount
do
begin
SaveFileName :=Copy(FileName,1,Pos('
.',FileName)-1) +
Copy(FileName,Pos('
.',FileName),
Length(FileName)-Pos('
.',FileName)+1);
if fileexists(pfadV+Form1.EVeExportrdy.text+'
.xls')=true
then deletefile(pfadV+Form1.EVeExportrdy.text+'
.xls');
XLApp.Workbooks[M].SaveAs(SaveFileName);
end;
Result := True;
except
// Error?
end;
finally
//Excel beenden
XLApp.DisplayAlerts := False;
XLApp.Quit;
XLAPP := Unassigned;
Sheet := Unassigned;
end;
end;
//Aufruf
procedure TForm1.BVeExportrdyClick(Sender: TObject);
begin
stringgrid6.RowCount:=stringgrid6.rowcount-1;
StringGridToExcelSheetV(StringGrid6, '
Stringgrid Print', pfadV+EVeExportrdy.text+'
.xls',True);
stringgrid6.RowCount:=stringgrid6.rowcount+1;
end;