Запуск и закрытие Excel, добавление и удаление книг и листов
01.01.2007
{ **** 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)=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.