Показать сообщение отдельно
  #3  
Старый 20.05.2017, 10:15
derekt derekt вне форума
Прохожий
 
Регистрация: 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.
Админ: Второе предупреждение! При рецедиве последуют санкции!
Ответить с цитированием