[Max7]

Нет, ошибся. LExcel для переноса таблицы базы данных в Excel.

Но есть чей-то пример очень наглядный работы с Excel:

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

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

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

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, ComObj, Dialogs,
StdCtrls;


type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Button3: TButton;
Button4: TButton;
Button5: TButton;
Button6: TButton;
Button7: TButton;
Button8: TButton;
Button9: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure Button6Click(Sender: TObject);
procedure Button7Click(Sender: TObject);
procedure Button8Click(Sender: TObject);
procedure Button9Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
Excel: Variant;

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);

implementation

{$R *.dfm}


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;


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

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

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

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

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

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

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

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

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

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


end.