unit MainUnit interface uses Windows Messages SysUtils Variants Classe

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
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.