20.05.2017, 10:15
|
Прохожий
|
|
Регистрация: 18.05.2017
Сообщения: 6
Версия Delphi: delphi 7
Репутация: 10
|
|
Все равно та же ошибка.
Код:
unit Unit1;
interface
uses
ComObj, ActiveX, Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
MyExcel: OleVariant;
const
ExcelApp = 'Excel.Application';
implementation
function CheckExcelInstall:boolean;
var
ClassID: TCLSID;
Rez : HRESULT;
begin
Rez := CLSIDFromProgID(PWideChar(WideString(ExcelApp)), ClassID);
if Rez = S_OK then
Result := true
else
Result := false;
end;
function CheckExcelRun: boolean;
begin
try
MyExcel:=GetActiveOleObject(ExcelApp);
Result:=True;
except
Result:=false;
end;
end;
function RunExcel(DisableAlerts:boolean=true; Visible: boolean=false): boolean;
begin
try
if CheckExcelInstall then
begin
MyExcel:=CreateOleObject(ExcelApp);
MyExcel.Application.EnableEvents:=DisableAlerts;
MyExcel.Visible:=True;
Result:=true;
end
else
begin
MessageBox(0,'Ïðèëîæåíèå MS Excel íå óñòàíîâëåíî íà âàøåì êîìïüþòåðå','Îøèáêà',MB_OK+MB_ICONERROR);
Result:=false;
end;
except
Result:=false;
end;
end;
function AddWorkBook(AutoRun:boolean=true):boolean;
begin
if CheckExcelRun then
begin
MyExcel.WorkBooks.Add;
Result:=true;
end
else
if AutoRun then
begin
RunExcel;
MyExcel.WorkBooks.Add;
Result:=true;
end
else
Result:=false;
end;
function SaveWorkBook(FileName:TFileName; WBIndex:integer):boolean;
begin
try
MyExcel.WorkBooks[1].SaveAs('c:\test.xlsx',xlWorkbookDefault);
if MyExcel.WorkBooks[1].Saved then
Result:=true
else
Result:=false;
except
Result:=false;
end;
end;
{$R *.dfm}
procedure TForm1.FormActivate(Sender: TObject);
begin
CheckExcelInstall;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
RunExcel;
AddWorkBook;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
SaveWorkBook;
end;
end.
Админ: Второе предупреждение! При рецедиве последуют санкции!
|