Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Запуск и закрытие Excel, добавление и удаление книг или листов

Автор: 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.
Проект Delphi World © Выпуск 2002 - 2024
Автор проекта: USU Software
Вы можете выкупить этот проект.