Автор: Lookin
WEB-сайт: http://delphibase.endimus.com

{ **** UBPFD *********** by delphibase.endimus.com ****
>> Запуск и закрытие Excel, добавление и удаление книг и листов

На данный момент работает:
- вызов и закрытие Excel
- добавление новых, открытие ранее созданных и удаление рабочих книг
- добавление и удаление листов в рабочие книги

Зависимости: ComObj, SysUtils,Dialogs,Controls;
Автор:       lookin, lookin@mail.ru, Екатеринбург
Copyright:   lookin
Дата:        04 мая 2002 г.
***************************************************** }

unit MSExcel;

interface

uses ComObj, SysUtils, Dialogs, Controls;

procedure CallExcel(Show: boolean);
procedure CloseExcel;
procedure AddWorkBook(WorkBookName: Ansistring);
procedure OpenWorkBook(WorkBookName: Ansistring);
procedure CloseWorkBook(WorkBookName: Ansistring);
procedure ActivateWorkBook(WorkBookName: Ansistring);
procedure ActivateWorkSheet(WorkBookName, WorkSheetName: Ansistring);
function WorkBookIndex(WorkBookName: Ansistring): integer;
function WorkSheetIndex(WorkBookName, WorkSheetName: Ansistring): integer;
procedure CheckExtension(Name: Ansistring);
procedure AddWorkSheet(WorkBookName, WorkSheetName: Ansistring);
procedure DeleteWorkSheet(WorkBookName, WorkSheetName: Ansistring);

var
  Excel: Variant;

implementation

procedure CallExcel(Show: boolean);
begin
  if VarIsEmpty(Excel) = true then
  begin
    Excel := CreateOleObject('Excel.Application');
    if Show then
      Excel.Visible := true;
  end;
end;

procedure CloseExcel;
begin
  if VarIsEmpty(Excel) = false then
  begin
    Excel.Quit;
    Excel := 0;
  end;
end;

procedure AddWorkBook(WorkBookName: Ansistring);
var
  k: integer;
begin
  CheckExtension(WorkBookName);
  if VarIsEmpty(Excel) = true then
  begin
    Excel := CreateOleObject('Excel.Application');
    Excel.Visible := true;
  end;
  k := WorkBookIndex(WorkBookName);
  if k = 0 then
  begin
    Excel.Workbooks.Add;
    Excel.ActiveWorkbook.SaveCopyAs(FileName := WorkBookName);
    Excel.ActiveWorkbook.Close;
    Excel.Workbooks.Open(WorkBookName);
  end
  else
    MessageDlg('Книга с таким именем уже существует.', mtWarning, [mbOk], 0);
end;

procedure OpenWorkBook(WorkBookName: Ansistring);
var
  k: integer;
begin
  CheckExtension(WorkBookName);
  if VarIsEmpty(Excel) = true then
  begin
    Excel := CreateOleObject('Excel.Application');
    Excel.Visible := true;
  end;
  k := WorkBookIndex(WorkBookName);
  if k = 0 then
    Excel.Workbooks.Open(WorkBookName)
  else
    MessageDlg('Книга с таким именем уже открыта.', mtWarning, [mbOk], 0);
end;

procedure CloseWorkBook(WorkBookName: Ansistring);
var
  k: integer;
begin
  if VarIsEmpty(Excel) = false then
  begin
    k := WorkBookIndex(WorkBookName);
    if k <> 0 then
      Excel.ActiveWorkbook.Close(WorkBookName)
    else
      MessageDlg('Книга с таким именем отсутствует.', mtWarning, [mbOk], 0);
  end;
end;

procedure ActivateWorkBook(WorkBookName: Ansistring);
var
  k: integer;
begin
  if VarIsEmpty(Excel) = false then
  begin
    k := WorkBookIndex(WorkBookName);
    if k <> 0 then
      Excel.WorkBooks[k].Activate;
  end;
end;

procedure ActivateWorkSheet(WorkBookName, WorkSheetName: Ansistring);
var
  k, j: integer;
begin
  if VarIsEmpty(Excel) = false then
  begin
    k := WorkBookIndex(WorkBookName);
    j := WorkSheetIndex(WorkBookName, WorkSheetName);
    if j <> 0 then
      Excel.WorkBooks[k].Sheets[j].Activate;
  end;
end;

procedure AddWorkSheet(WorkBookName, WorkSheetName: Ansistring);
var
  k, j: integer;
begin
  if VarIsEmpty(Excel) = false then
  begin
    k := WorkBookIndex(WorkBookName);
    if k <> 0 then
    begin
      Excel.DisplayAlerts := False;
      Excel.Workbooks[k].Sheets.Add;
      j := WorkSheetIndex(WorkBookName, WorkSheetName);
      if j = 0 then
        Excel.Workbooks[k].ActiveSheet.Name := WorkSheetName;
    end;
  end;
end;

procedure DeleteWorkSheet(WorkBookName, WorkSheetName: Ansistring);
var
  k, j: integer;
begin
  if VarIsEmpty(Excel) = false then
  begin
    k := WorkBookIndex(WorkBookName);
    Excel.DisplayAlerts := false;
    j := WorkSheetIndex(WorkBookName, WorkSheetName);
    if j <> 0 then
      Excel.Workbooks[k].Sheets[j].Delete
    else
      MessageDlg('Листа с таким именем в этой книге нет.', mtWarning, [mbOk],
        0);
  end;
end;

procedure CheckExtension(Name: Ansistring);
var
  s: string;
begin
  //проверка расширения
  s := ExtractFileExt(Name);
  if LowerCase(s) <> '.xls' then
    if
      MessageDlg('Вы задали имя книги с нестандартным расширением. Продолжить?',
      mtWarning, [mbYes, mbCancel], 0) = mrCancel then
      Abort;
end;

function WorkBookIndex(WorkBookName: Ansistring): integer;
var
  i, n: integer;
begin
  //проверка на наличие книги с этим именем
  n := 0;
  if VarIsEmpty(Excel) = false then
    for i := 1 to Excel.WorkBooks.Count do
      if Excel.WorkBooks[i].FullName = WorkBookName then
      begin
        n := i;
        break;
      end;
  WorkBookIndex := n;
end;

function WorkSheetIndex(WorkBookName, WorkSheetName: Ansistring): integer;
var
  i, k, n: integer;
begin
  //проверка на наличие листа с этим именем в книге с этим именем
  n := 0;
  if VarIsEmpty(Excel) = false then
  begin
    k := WorkBookIndex(WorkBookName);
    for i := 1 to Excel.WorkBooks[k].Sheets.Count do
      if Excel.WorkBooks[k].Sheets[i].Name = WorkSheetName then
      begin
        n := i;
        break;
      end;
  end;
  WorkSheetIndex := n;
end;

end.

Пример использования:

procedure TForm1.Button1Click(Sender: TObject);
begin
  //вызов Excel, true - если хотите при вызове Excel отобразить окно Excel
  CallExcel(true);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  //добавление новой рабочей книги с заданным именем
  //ВАЖНО: используйте полное имя рабочей книги, т.е. включая путь
  AddWorkBook('D:\qwerty.xls');
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  //добавление листа с именем ff в рабочую книгу D:\qwerty.xls
  AddWorksheet('D:\qwerty.xls', 'ff');
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
  //активация рабочей книги
  ActivateWorkBook('D:\1234.xls');
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
  //активация листа в рабочей книге
  ActivateWorkSheet('D:\qwerty.xls', 'ff');
end;

procedure TForm1.Button6Click(Sender: TObject);
begin
  //открытие рабочей книги
  OpenWorkBook('D:\qwerty.xls');
end;

procedure TForm1.Button7Click(Sender: TObject);
begin
  //закрытие рабочей книги
  CloseWorkBook('D:\qwerty.xls');
end;

procedure TForm1.Button8Click(Sender: TObject);
begin
  //удаление листа из рабочей книги
  DeleteWorkSheet('D:\qwerty.xls', 'ff');
end;

procedure TForm1.Button9Click(Sender: TObject);
begin
  //закрытие Excel
  CloseExcel;
end;

end.