//StringGrid-Inhalt nach Excel exportieren
function StringGridToExcelSheet(Grid: TStringGrid; SheetName, FileName:
string;
ShowExcel: Boolean): Boolean;
const
xlWBATWorksheet = -4167;
var
SheetCount, SheetColCount, SheetRowCount, BookCount: Integer;
XLApp, Sheet, Data: 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
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, 1, SheetColCount], varVariant);
for I := 0
to SheetColCount - 1
do
for J := 0
to SheetRowCount - 1
do
if ((I+256*(N-1)) <= Grid.ColCount)
and ((J+65536*(M-1)) <= Grid.RowCount)
then
Data[J + 1, I + 1] := Grid.Cells[I+256*(N-1), J+65536*(M-1)];
XLApp.Worksheets[N].Select;
XLApp.Workbooks[M].Worksheets[N].
Name := SheetName + IntToStr(N);
//Zellen als String Formatieren
XLApp.Workbooks[M].Worksheets[N].Range[RefToCell(1, 1), RefToCell(SheetRowCount,
SheetColCount)].Select;
XLApp.Selection.NumberFormat := '
@';
//XLApp.Workbooks[M].Cells.EntireColumn.AutoFit; -> Hier hätte ich es eingesetzt
XLApp.Workbooks[M].Worksheets[N].Range['
A1'].Select;
//Daten dem Excelsheet übergeben
Sheet := XLApp.Workbooks[M].WorkSheets[N];
Sheet.Range[RefToCell(1, 1), RefToCell(SheetRowCount,SheetColCount)].Value := Data;
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(pfadE+Form1.EExportname.text+'
.xls')=true
then deletefile(pfadE+Form1.EExportname.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;