TExcelServer =
class
private
{$REGION 'Wrapperklassen'}
FOwner : TComponent;
FLCID : Integer;
FConnected : boolean;
ExcelApplication : TExcelApplication;
ExcelWorkbook : TExcelWorkbook;
ExcelWorksheet : TExcelWorksheet;
ExcelPivotTables : PivotTables;
ExcelPivotTable : PivotTable;
ExcelPivotFields : PivotFields;
ExcelPivotField : PivotField;
ExcelPivotDataFields : PivotFields;
ExcelPivotDataField : PivotField;
ExcelPivotItems : PivotItems;
ExcelPivotItem : PivotItem;
ExcelChart : TExcelChart;
ExcelChartSeriesCollection : SeriesCollection;
ExcelChartSeries : Series;
ExcelChartObjects : ChartObjects;
ExcelChartObject : ChartObject;
FbIsAppWbOpen,
FbIsAppWbNew : boolean;
{$ENDREGION}
...
{$REGION 'Workbook -------------------------------------------------------------------'}
procedure WorkbookNew(Template: xlWBATemplate = xlWBATWorksheet);
{$ENDREGION}
{$REGION 'Worksheet ------------------------------------------------------------------'}
procedure WorksheetNew(Template: xlWBATemplate = xlWBATWorksheet);
{$ENDREGION}
{$REGION 'Pivot ----------------------------------------------------------------------'}
procedure DeselectAllPivotItems(
Name :
string);
function GetPivotFormatType(PivotFormatType : TIvuPivotAutoFormatType) : Longword;
function GetPivotFieldItems(Field :
string; F : xlPivotFieldOrientation) : TStrings;
{$ENDREGION}
{$REGION 'I/O Hilfe ------------------------------------------------------------------'}
// übersetzt Row, Col in, für Excel verständliche "Zellenadresse"
function TranslateCell(Row, Col : integer) :
string;
procedure TranslateRange(fromRow, fromCol, toRow, toCol : integer;
var FromCell, ToCell :
string);
function TranslateColumn(Col : integer) :
string;
procedure MacroRun(
Name:
string);
overload;
// Maximal 18 Argumente Rest wird ignoriert
procedure MacroRun(
Name:
string; Args: TStringList);
overload;
// schreibt das Makro Macro in das aktuelle
procedure MacroSet(Macro : TStringList);
{$ENDREGION}
...
public
constructor Create(AOwner : TComponent; sExcelPath :
string);
destructor Destroy;
override;
{$REGION 'allgemein ------------------------------------------------------------------'}
function IsRegistered : boolean;
procedure CloseExcel;
procedure StartExcel(StartSeperateInstance : boolean = false);
procedure DisconnectAll;
procedure OpenFile(sFileName :
string);
procedure NewFile;
procedure Run(MacroName :
string);
overload;
procedure Run(MacroName :
string; Argumente : TStringList);
overload;
procedure InsertMacro(Text : TStringList);
function MacroExsists(MacroName :
string = '
') : boolean;
{$ENDREGION}
{$REGION 'Workbook -------------------------------------------------------------------'}
procedure OnAppWorkbookOpen(ASender: TObject;
const Wb: ExcelWorkbook);
procedure OnAppWorkbookNew(ASender: TObject;
const Wb: ExcelWorkbook);
procedure SaveActiveWorkbookAs(sFileName :
string; TryOverride : boolean = true);
overload;
procedure SaveActiveWorkbookAs;
overload;
procedure SaveActiveWorkbook;
{$ENDREGION}
...
{$REGION 'PivotTable -----------------------------------------------------------------'}
procedure PivotRefresh;
// Gibt die Nummer des ersten Worksheets zurück, das eine Pivottabelle enthält.
// ansonsten wird 0 zurückgegeben.
function PivotFind : integer;
procedure PivotSet(Source, SheetName :
string;
fromRowSource, fromColSource,
toRowSource, toColSource,
fromRowDest, fromColDest,
toRowDest, toColDest : integer);
procedure PivotSet2(Source, SheetName :
string;
fromRowSource, fromColSource,
toRowSource, toColSource : integer;
fromRowDest : integer = 1; fromColDest : integer = 1);
procedure PivotFormatSet(Format : TIvuPivotAutoFormatType);
function PivotFormatGet(Format :
string) : TIvuPivotAutoFormatType;
procedure SplitPivotChart_Page(withChart : boolean;
Field :
string;
FDiagrammtyp :
string;
bDublicateFooter : boolean;
Position : THeaderFooterPosition);
{$ENDREGION}
...
{$REGION 'Chart ----------------------------------------------------------------------'}
function FindBuildinChartTypes : TStrings;
procedure ChartSet(Source, SheetName :
string;
Charttype : TIvuExcelChartType;
fromRowSource, fromColSource,
toRowSource, toColSource : integer;
fromPivot : boolean = false);
overload;
// nur von Pivot
procedure ChartSet(Source, SheetName :
string;
Charttype : TIvuExcelChartType);
overload;
procedure CustomChartSet(Source, SheetName, ChartName :
string;
fromRowSource, fromColSource,
toRowSource, toColSource : integer;
fromPivot : boolean = false);
procedure SetChartTitle(
Name :
string);
procedure SetChartXAchse(
Name :
string);
procedure SetChartYAchse(
Name :
string);
procedure SetChartXAchseCross(At : TIvuExcelChartAxisCross);
procedure SetChartYAchseCross(At : TIvuExcelChartAxisCross);
procedure ChartTypeSet(ChartType : TIvuExcelChartType);
function ChartTypeGet(ChartType :
string) : TIvuExcelChartType;
procedure SetChartNewSeries(XfromRowSource, XtoRowSource, XColSource,
YfromRowSource, YtoRowSource, YColSource : integer;
Name :
string);
{$ENDREGION}
...
end;
constructor TExcelServer.Create(AOwner : TComponent; sExcelPath :
string);
begin
//Überprüfung ob Excel auf Rechner installiert ist
try
if IsRegistered = false
then
raise EExcelNotInstalled.Create(rcExcelNotInstalled);
except
if not SysUtils.FileExists(sExcelPath)
then
raise EExcelNotInstalled.Create(rcExcelNotInstalled);
end;
// für Testzwecke
// raise EExcelNotInstalled.Create(rcExcelNotInstalled);
FOwner := AOwner;
ExcelApplication := TExcelApplication.Create(AOwner);
Sleep(100);
ExcelWorkbook := TExcelWorkbook.Create(AOwner);
ExcelWorksheet := TExcelWorksheet.Create(AOwner);
ExcelPivotTables :=
nil;
ExcelPivotTable :=
nil;
ExcelChart := TExcelChart.Create(AOwner);
ExcelChartObjects :=
nil;
ExcelChartObject :=
nil;
FConnected := false;
FLCID := GetUserDefaultLCID;
end;
destructor TExcelServer.Destroy;
begin
try
try
ExcelChart.Disconnect;
finally
ExcelChart.Free;
end;
except
end;
try
try
ExcelWorksheet.Disconnect;
finally
ExcelWorksheet.Free;
end;
except
end;
try
try
ExcelWorkbook.Disconnect;
finally
ExcelWorkbook.Free;
end;
except
end;
try
try
ExcelApplication.Disconnect;
finally
ExcelApplication.Free;
end;
except
end;
inherited Destroy;
end;
// allgemein -------------------------------------------------------------------
function TExcelServer.IsRegistered : boolean;
var Reg: TRegistry;
bVorhanden : boolean;
begin
bVorhanden := false;
//Prüfung ob Excel installiert
Reg := TRegistry.Create;
try
Reg.RootKey := HKEY_CLASSES_ROOT;
Reg.Access := KEY_EXECUTE;
bVorhanden := Reg.KeyExists(cExcelRegKey);
finally
Reg.Free;
result := bVorhanden;
end;
end;
procedure TExcelServer.StartExcel(StartSeperateInstance : boolean = false);
begin
FConnected := false;
try
if StartSeperateInstance
then
begin
ExcelApplication.ConnectKind := ckNewInstance;
end
else
begin
ExcelApplication.ConnectKind := ckRunningOrNew;
end;
ExcelApplication.Connect;
ExcelApplication.EnableEvents := true;
ExcelApplication.OnWorkbookOpen := OnAppWorkbookOpen;
ExcelApplication.OnNewWorkbook := OnAppWorkbookNew;
// ExcelApplication.UserControl := false;
ExcelApplication.DisplayAlerts[FLCID] := true;
{Excel-Arbeitsblätter können Verknüpfungen zu anderen Dateien haben.
Hier wird der Verknüpfungen-Aktualisieren Dialog unterdrückt}
ExcelApplication.AskToUpdateLinks[FLCID] := false;
ExcelApplication.Visible[FLCID] := false;
// sometimes a previous bad finished session can have visible = true
FConnected := true;
except
try
ExcelApplication.Disconnect;
ExcelApplication.ConnectKind := ckNewInstance;
ExcelApplication.Connect;
ExcelApplication.EnableEvents := true;
ExcelApplication.OnWorkbookOpen := OnAppWorkbookOpen;
ExcelApplication.OnNewWorkbook := OnAppWorkbookNew;
ExcelApplication.DisplayAlerts[FLCID] := true;
ExcelApplication.AskToUpdateLinks[FLCID] := false;
ExcelApplication.Visible[FLCID] := false;
// sometimes a previous bad finished session can have visible = true
FConnected := true;
except
raise EExcelOpen.Create(rcExcelOpenError);
end;
end;
end;
function TExcelServer.FindBuildinChartTypes: TStrings;
function FileSearch(Path :
String = '
') :
string;
const
Mask = '
Xl8galry.xls';
StartFolder = '
\Microsoft Office';
var
Rec : TSearchRec;
begin
Result := '
';
if Path = '
'
then
Path := GetEnvironmentVariable('
Programfiles') + StartFolder;
if FindFirst(Path + '
\' + Mask, faAnyFile - faDirectory, Rec) = 0
then
begin
Result := Path + '
\' + Rec.
Name;
SysUtils.FindClose(Rec);
Exit;
end
else
begin
if FindFirst(Path + '
\*.*', faDirectory, Rec) = 0
then
begin
repeat
if ((Rec.Attr
and faDirectory) = faDirectory)
and
(Rec.
Name[1] <> '
.')
then
Result := FileSearch(Path + '
\' + Rec.
Name);
until (FindNext(Rec) <> 0)
or (Result <> '
');
end;
end;
SysUtils.FindClose(Rec);
end;
// NUR Excel 2007
function FileSearch_abVersion12(Path :
String = '
') : TStrings;
const
Mask = '
*.crtx';
StartFolder = '
\Anwendungsdaten\Microsoft\Templates\Charts';
var
Rec : TSearchRec;
begin
Result := TStringList.Create;
if Path = '
'
then
Path := GetEnvironmentVariable('
Userprofile') + StartFolder;
if FindFirst(Path + '
\' + Mask, faAnyFile - faDirectory, Rec) = 0
then
begin
repeat
Result.Add(ChangeFileExt(ExtractFileName(Rec.
Name), '
'));
until (FindNext(Rec) <> 0);
end
else
begin
if FindFirst(Path + '
\*.*', faDirectory, Rec) = 0
then
begin
repeat
if ((Rec.Attr
and faDirectory) = faDirectory)
and
(Rec.
Name[1] <> '
.')
then
Result.AddStrings(FileSearch_abVersion12(Path + '
\' + Rec.
Name));
until (FindNext(Rec) <> 0);
end;
end;
SysUtils.FindClose(Rec);
end;
// NUR Excel 2007
var
i : integer;
f :
string;
ExApp : TExcelApplication;
WB : TExcelWorkbook;
CH : TExcelChart;
begin
Result := TStringList.Create;
StartExcel(true);
case Version.Major
of
0..11 :
begin
if not Assigned(CustomChartTypeList)
then
begin
f := FileSearch;
if f <> '
'
then
begin
try
ExApp := TExcelApplication.Create(FOwner);
ExApp.ConnectKind := ckNewInstance;
ExApp.Connect;
try
ExApp.EnableEvents := true;
except
MessageDlg(rcExcelEnableEventsError, mtError, [mbOK], 0);
ExApp.EnableEvents := true;
end;
ExApp.DisplayAlerts[FLCID] := false;
ExApp.AskToUpdateLinks[FLCID] := false;
ExApp.Visible[FLCID] := false;
ExApp.OnWorkbookOpen := OnAppWorkbookOpen;
FbIsAppWbOpen := false;
ExApp.Workbooks.Open
(f,
EmptyParam
{UpdateLinks}, EmptyParam
{ReadOnly},
EmptyParam
{Format}, EmptyParam
{Password},
EmptyParam
{WriteResPassword}, EmptyParam
{IgnoreReadOnlyRecommended},
EmptyParam
{Origin}, EmptyParam
{Delimiter},
EmptyParam
{Editable}, EmptyParam
{Notify},
EmptyParam
{Converter}, EmptyParam
{AddToMru},
FLCID);
while not FbIsAppWbOpen
do begin end;
// auf Excel warten, bis Workbook offen ist
WB := TExcelWorkbook.Create(FOwner);
WB.ConnectTo(ExApp.ActiveWorkbook);
CH := TExcelChart.Create(FOwner);
for i := 1
to WB.Sheets.Count
do begin
CH.ConnectTo(WB.Sheets.Item[i]
as _Chart);
Result.Add(CH.
Name);
end;
finally
CH.Free;
WB.Free;
ExApp.Quit;
ExApp.Disconnect;
end;
end;
CustomChartTypeList := TStringList.Create;
CustomChartTypeList.Assign(Result);
end
else
Result.Assign(CustomChartTypeList);
end;
12 :
begin
// ChartTemplate funktioniert bei Excel 2007 (noch) nicht
// Result.Assign(FileSearch_abVersion12);
end;
end;
CloseExcel;
end;
procedure TExcelServer.PivotSet(Source, SheetName :
string;
fromRowSource, fromColSource,
toRowSource, toColSource : integer;
fromRowDest : integer = 1; fromColDest : integer = 1);
begin
// siehe: [url]http://support.microsoft.com/?scid=kb%3Ben-us%3B177169&x=13&y=13[/url]
if Version.Major < 10
then
begin
PivotSet(Source, SheetName, fromRowSource, fromColSource, toRowSource, toColSource, fromRowDest, fromColDest, fromRowDest, fromColDest);
end
else
begin
try
WorksheetAdd(SheetName);
ExcelPivotTable := ExcelWorksheet.PivotTableWizard(xlDatabase
{SourceType},
Source +
'
!R' + IntToStr(fromRowSource) +
'
C' + IntToStr(fromColSource) +
'
:R' + IntToStr(toRowSource) +
'
C' + IntToStr(toColSource)
{SourceData},
EmptyParam
{TableDestination},
'
PivotTable1'
{TableName},
EmptyParam
{RowGrand},
EmptyParam
{ColumnGrand},
EmptyParam
{SaveData},
EmptyParam
{HasAutoFormat},
EmptyParam
{AutoPage},
EmptyParam
{Reserved},
EmptyParam
{BackgroundQuery},
EmptyParam
{OptimizeCache},
EmptyParam
{PageFieldOrder},
EmptyParam
{PageFieldWrapCount},
EmptyParam
{ReadData},
EmptyParam
{Connection},
FLCID);
ExcelPivotTables := ExcelWorksheet.PivotTables(EmptyParam, FLCID)
as PivotTables;
ExcelPivotFields := ExcelPivotTable.PivotFields(EmptyParam)
as PivotFields;
if fromRowDest > 1
then begin
InsertRow(0, fromRowDest - 1);
end;
if fromColDest > 1
then begin
InsertColumn(0, fromColDest - 1);
end;
except
raise EExcelPivotSet.Create(rcExcelPivotSetError);
end;
end;
end;
procedure TExcelServer.ChartSet(
Source,
SheetName :
string;
Charttype : TIvuExcelChartType;
fromRowSource,
fromColSource,
toRowSource,
toColSource : integer;
fromPivot : boolean);
begin
WorksheetConnect(Source);
ExcelChart.ConnectTo(ExcelWorkbook.Charts.Add(EmptyParam, ExcelApplication.Sheets.Item[Source]
as _WorkSheet, 1, EmptyParam, FLCID)
as _Chart);
ExcelChart.ChartType := GetChartType(Charttype);
if fromPivot
then begin
try
ExcelChart.ChartWizard(ExcelPivotTable.DataBodyRange);
except
on E :
Exception do
raise EExcelChartSetSourceData.Create(rcExcelChartSetError);
end;
end
else begin
try
ExcelChart.ChartWizard(ExcelWorksheet.Range[TranslateCell(fromRowSource + 1, fromColSource + 1),
TranslateCell(toRowSource + 1, toColSource + 1)]);
except
on E :
Exception do
raise EExcelChartSetSourceData.Create(rcExcelChartSetError);
end;
end;
ExcelChartObjects := (ExcelWorksheet.ChartObjects
as ChartObjects);
if ExcelChartObjects.Count > 0
then
ExcelChartObject := (ExcelChartObjects.Item(1)
as ChartObject);
try
SetChartTitle(SheetName);
except
if Length(SheetName) = 31
then
SetLength(SheetName, 29);
SheetName := SheetName + IntToStr(ExcelWorkbook.Worksheets.Count - 1);
try
SetChartTitle(SheetName);
except
on E :
Exception do
raise EExcelRenameWorksheet.Create(Format(rcExcelRenameSheetError, [ExcelWorksheet.
Name, SheetName]));
end;
end;
end;