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



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

{ **** UBPFD *********** by delphibase.endimus.com ****
>> Запуск и закрытие Excel, добавление и удаление книг и листов
На данный момент работает:
- вызов и закрытие Excel
- добавление новых, открытие ранее созданных и удаление рабочих книг
- добавление и удаление листов в рабочие книги
Зависимости: ComObj, SysUtils,Dialogs,Controls;
Автор:       lookin, [email protected], Екатеринбург
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.

Далее: Зарисовка на тему экспорта в Excel »»