Запуск и закрытие Excel, добавление и удаление книг и листов

Материал из DRKB


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

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

Зависимости: ComObj, SysUtils,Dialogs,Controls;
Автор:       lookin, lookin@mail.ru, Екатеринбург<br>
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) then
  begin
    Excel := CreateOleObject('Excel.Application');
    if Show then
      Excel.Visible := True;
  end;
end;

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

procedure AddWorkBook(WorkBookName: AnsiString);
var
  k: Integer;
begin
  CheckExtension(WorkBookName);
  if VarIsEmpty(Excel) 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) 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) then Exit;
  k := WorkBookIndex(WorkBookName);
  if k <> 0 then
    Excel.ActiveWorkbook.Close(WorkBookName)
  else
    MessageDlg('Книга с таким именем отсутствует.', mtWarning, [mbOk], 0);
end;

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

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

procedure AddWorkSheet(WorkBookName, WorkSheetName: AnsiString);
var
  k, j: Integer;
begin
  if VarIsEmpty(Excel) then Exit;
  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;

procedure DeleteWorkSheet(WorkBookName, WorkSheetName: AnsiString);
var
  k, j: Integer;
begin
  if VarIsEmpty(Excel) then Exit;
  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;

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) then Exit;
  for i := 1 to Excel.WorkBooks.Count do
  begin
    if Excel.WorkBooks[i].FullName = WorkBookName then
    begin
      n := i;
      break;
    end;
  end;
  WorkBookIndex := n;
end;

function WorkSheetIndex(WorkBookName, WorkSheetName: AnsiString): Integer;
var
  i, k, n: Integer;
begin
  // проверка на наличие листа с этим именем в книге с этим именем
  n := 0;
  if VarIsEmpty(Excel) then Exit;
  k := WorkBookIndex(WorkBookName);
  for i := 1 to Excel.WorkBooks[k].Sheets.Count do
  begin
    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.


Author: lookin
ID: 04405