unit MainUnit interface uses Windows Messages SysUtils Variants Classe

unit MainUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, XPMan, StdCtrls, ExtCtrls, ComObj, DB, DBTables;

type
  TMainForm = class(TForm)
    btRun: TButton;
    btOpen: TButton;
    Memo: TMemo;
    Style: TXPManifest;
    Img: TImage;
    Table: TTable;
    procedure btRunClick(Sender: TObject);
    procedure btOpenClick(Sender: TObject);
    procedure CreateBases;
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;
  XLS,WB,ws:OLEVariant;
implementation

{$R *.dfm}
// Создание обьекта Excel
procedure TMainForm.btOpenClick(Sender: TObject);
begin
XLS:=CreateOleObject('Excel.Application');
XLS.Visible:=true;
end;

procedure TMainForm.btRunClick(Sender: TObject);
var
  wsc, fc, r, t, i: Integer;
  s1, attr_name: String;
begin
   CreateBases;
   WB := xls.Workbooks[1];
   Memo.Lines.Clear;
   i := 1;
   t := 1;
   attr_name := 't';
   for wsc := 2 to WB.Worksheets.Count do
   begin
      ws := WB.Worksheets[wsc];
      ws.Activate;
      fc := 1;
      Memo.Lines.Add(ws.Cells[1,FC].Value);
      r := 6;
      ws.Cells[R, FC].Select;
      while xls.Selection.Cells[1,1].Value <> '' do
      begin
        s1 := xls.Selection.Cells[1,1].Value;
        Memo.Lines.Add(s1);
        if Table.Locate('full_name', s1, []) = false then
        begin
          Table.Append;
          Table['id'] := i;
          Table['attr_id'] := attr_name + IntToStr(t);
          Table['full_name'] := Trim(s1);
          Table.Post;
          Inc(i);
          Inc(t);
        end;
        r := r + xls.Selection.Rows.Count;
        xls.Cells[R, FC].Select;
      end;
      Memo.Lines.Add('');
   end;
   Table.Close;
end;


procedure TMainForm.CreateBases;
begin
     with Table do
     begin
      Active := False;
      TableType := ttFoxPro;
      TableName := 'Attrib';
      if not Exists then
      begin
        with FieldDefs do begin
          Clear;
          with AddFieldDef do begin
            Name := 'id';
            DataType := ftSmallint;
          end;
          with AddFieldDef do begin
            Name := 'attr_id';
            DataType := ftString;
            Size := 4;
          end;
          with AddFieldDef do begin
            Name := 'full_name';
            DataType := ftString;
            Size := 100;
          end;
        end;
        CreateTable;
      end;
      Active := True;
     end;
end;

end.