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

{ **** UBPFD *********** by kladovka.net.ru ****
>> Запуск и закрытие 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) 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
Category:COM
Category:MS Office