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
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
| unit XLReps;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics,
ComObj, Excel2000, OleServer, DB, Variants, Dialogs;
type
// Выравнивание текста внутри ячейки :
CXLExp_HorAlignment = (ehaLeft,ehaRight,ehaCenter,ehaNone); // горизонтальное
CXLExp_VertAlignment = (evaTop,evaBottom,evaCenter,evaResize,evaMultiLine,evaNone); // вертикальное
// Толщина и наклон символов
CXLExp_FontStyle = (efsBold, efsItalic, efsNone);
SXLExp_FontStyle = set of CXLExp_FontStyle;
CXLExp_BorderStyle = (ebsThin, ebsMedium, ebsThick, ebsBlank);
RXLExp_Text = record
Hor: CXLExp_HorAlignment; // Горизонтальное
Vert: CXLExp_VertAlignment; // Вертикальное
WrdWrap: boolean; // Перенос по словам
end;
RXLExp_Font = record
Name: TFontName; // Название шрифта (если '', то Default
Color: TColor; // Цвет шрифта
Size: ShortInt; // Размер шрифта (если AutoSize=true, игнорируется)
Style: TFontStyles; // Стиль (fsBold,fsItalic,fsUnderline,fsStrikeOut)
end;
RXLExp_CellsProp = record // ******** Свойства ячеек
Align: RXLExp_Text; // Выравнивание текста внутри ячейки
Font: RXLExp_Font; // Фонт
Width: integer; // Ширина ячейки в ед.Excel (если -1, то не уст-ся)
Height: integer; // Высота ячейки в ед.Excel (если -1, то не уст-ся)
Value: OleVariant; // Значение ячейки
Color: TColor; // Цвет фона
// ВАЖНО ! При установке цвета фона следует учитывать, что палитра цветов
// Excel`а существенно отличается от принятого в Windows, что может привести
// к тому, что вместо светло-серого ячейки окрасятся в черный, т.к. полутона
// екселем интерпретируются в полный, насыщенный цвет палитры RGB
end;
RXLExp_Region = record
ColLeft: word; // Колонка начала
RowTop: word; // Строка начала
ColRight: word; // Колонка конца
RowBottom: word; // Строка конца
JoinCells: boolean; // Объединения ячеек (только для региона)
Text: string; // Текст в ячейках
end;
// Открывает Excel-объект для вывода отчета
procedure XLExp_OpenReport(TemplateName: OleVariant);
// Закрывает Excel-объект
procedure XLExp_CloseReport;
// Устанавливает свойства ячеек в заданном районе
procedure XLExp_SetCellsProp(Region: RXLExp_Region; CellsProp: RXLExp_CellsProp);
// Возращает объект "Свойства" для указанного района ячеек
procedure XLEXP_GetCellsProp(Region: RXLExp_Region; var CellsProp: RXLExp_CellsProp);
// Задать ширину колонки
procedure XLExp_SetColumnWidth(Col,Width: integer);
// Слить ячейки в одну область
procedure XLExp_MergeCells(Region: RXLExp_Region);
// Запись в указанный район ячеек текста со слитием ячеек, выравниванием по центру
// и заданным размером и типом шрифта
procedure XLExp_CaptionInRange(Region: RXLExp_Region; Txt: string;
FntSize: word; FntStyle: SXLExp_FontStyle; Mrg: boolean);
// Процедура обводит ячейки указанного района листа решеткой заданной ширины
procedure XLExp_DrowBorder(Region: RXLExp_Region; Brd: CXLExp_BorderStyle);
// Занести текст в указанную ячейку
function XLExp_SetDataInCell(Index1,Index2: OleVariant; Data: string):string;
procedure XLExp_DataSetExport(Range:OleVariant; DataSet:TDataSet);
function XLExp_ShowReport: boolean;
function XLExp_GetLastRow(Range:OleVariant; DataSet:TDataSet):integer;
var
XLExp_Report: TExcelApplication;
XLExp_WorkBook: Excel2000.ExcelWorkBook;
XLExp_Sheet: Excel2000.ExcelWorkSheet;
XLExp_Col: array [1..40] of string=('A','B','C','D','E','F','G','H','I','J','K','L','M','N','O','P','Q','R','S','T','U','V','W','X','Y','Z','AA','AB','AC','AE','AD','AE','AF','AG','AH','AI','AJ','AK','AL','AM');
implementation
uses TypInfo, SysConst, MaskUtils, Math, Registry;
procedure XLExp_OpenReport(TemplateName: OleVariant);
// Процедура создает в первый раз Excel-приложение, а если оно уже существует,
// то коннектится к нему, определяя опции коннекта и создавая объекты "Книга"
// и "Лист". Имя книги задается параметром TemplateName
begin
if not Assigned(XLExp_Report) then
XLExp_Report:=TExcelApplication.Create(nil);
XLExp_Report.ConnectKind:=ckRunningOrNew;
XLExp_Report.Connect;
try
// если офис 2003, ХР
XLExp_WorkBook :=XLExp_Report.Workbooks.Add('',0);
except
try
// если офис 2000
XLExp_WorkBook :=XLExp_Report.Workbooks.Add('Книга1',0);
except
try
//если Офис 97
XLExp_WorkBook :=XLExp_Report.Workbooks.Add(xlWBatWorkSheet,0);
except
end;
end;
end;
XLExp_Sheet:=XLExp_Workbook.Worksheets.Item[1] as Excel2000.ExcelWorkSheet;
end;
procedure XLExp_CloseReport;
// Процедура закрывет Excel-приложение и освобождает занятые им ресурсы
begin
if Assigned(XLExp_Report) then
begin
XLExp_Sheet:=nil;
XLExp_Workbook:=nil;
FreeAndNil(XLExp_Report);
end;
end;
procedure XLEXP_SetCellsProp(Region: RXLExp_Region; CellsProp: RXLExp_CellsProp);
// Присваивает ячейкам заданного района указанные свойства
begin
with XLExp_Sheet.Range[XLExp_Col[Region.ColLeft]+IntToStr(Region.RowTop),
XLExp_Col[Region.ColRight]+IntToStr(Region.RowBottom)] do
begin
case CellsProp.Align.Hor of
ehaLeft: HorizontalAlignment := xlLeft;
ehaRight: HorizontalAlignment := xlRight;
ehaCenter: HorizontalAlignment := xlCenter;
ehaNone: HorizontalAlignment := xlDefaultAutoFormat;
end;
case CellsProp.Align.Vert of
evaResize: VerticalAlignment := xlGeneral;
evaMultiLine: VerticalAlignment := xlDistributed;
evaTop: VerticalAlignment := xlTop;
evaBottom: VerticalAlignment := xlBottom;
evaCenter: VerticalAlignment := xlCenter;
evaNone: VerticalAlignment := xlDefaultAutoFormat;
end;
WrapText := CellsProp.Align.WrdWrap;
Font.Bold := fsBold in CellsProp.Font.Style;
Font.Italic := fsItalic in CellsProp.Font.Style;
Font.Strikethrough := fsStrikeOut in CellsProp.Font.Style;
Font.Subscript := fsUnderline in CellsProp.Font.Style;
Font.Color := CellsProp.Font.Color;
Font.Size := CellsProp.Font.Size;
if CellsProp.Font.Name>'' then Font.Name := CellsProp.Font.Name;
Interior.Color := CellsProp.Color;
if CellsProp.Width>-1 then Columns.ColumnWidth := CellsProp.Width;
if CellsProp.Height>-1 then Rows.RowHeight := CellsProp.Height;
MergeCells := Region.JoinCells;
if Region.Text>'' then Value := Region.Text;
end;
//--------------------------------------------------------------------------
//преобразование формата в ячеек в текстовый всю выделенную область
XLExp_Sheet.Range[XLExp_Col[Region.ColLeft]+IntToStr(Region.RowTop),
XLExp_Col[Region.ColRight]+IntToStr(Region.RowBottom)].NumberFormat:= '@';
// @ этот параметр устанавливает текстовый формат
// 0 - числовое значение
// m/d/yyyy - дата
// #,##0.00$ - денежный
//--------------------------------------------------------------------------
end;
procedure XLEXP_GetCellsProp(Region: RXLExp_Region; var CellsProp: RXLExp_CellsProp);
// Возращает объект "Свойства" для указанного района ячеек
begin
with XLExp_Sheet.Range[XLExp_Col[Region.ColLeft]+IntToStr(Region.RowTop),
XLExp_Col[Region.ColRight]+IntToStr(Region.RowBottom)] do
begin
CellsProp.Align.WrdWrap := WrapText;
CellsProp.Font.Style := [];
if Font.Bold then Include(CellsProp.Font.Style,fsBold);
if Font.Italic then Include(CellsProp.Font.Style,fsItalic);
if Font.Strikethrough then Include(CellsProp.Font.Style,fsStrikeOut);
if Font.Subscript then Include(CellsProp.Font.Style,fsUnderline);
CellsProp.Font.Color := Font.Color;
CellsProp.Color := Interior.Color;
if CellsProp.Width>-1 then Columns.ColumnWidth := CellsProp.Width;
if CellsProp.Height>-1 then Rows.RowHeight := CellsProp.Height;
Region.JoinCells := MergeCells;
end;
end;
procedure XLExp_SetColumnWidth(Col,Width: integer);
// Изменить ширину колонки
begin
XLExp_Sheet.Range[XLExp_Col[Col]+'1',XLExp_Col[Col]+'1'].ColumnWidth := Width + 1;
end;
procedure XLExp_MergeCells(Region: RXLExp_Region);
// Слить ячейки
begin
XLExp_Sheet.Range[XLExp_Col[Region.ColLeft]+IntToStr(Region.RowTop),
XLExp_Col[Region.ColRight]+IntToStr(Region.RowBottom)].MergeCells := true;
end;
procedure XLExp_CaptionInRange(Region: RXLExp_Region; Txt: string;
FntSize: word; FntStyle: SXLExp_FontStyle; Mrg: boolean);
// Запись в указанный район ячеек текста со слитием ячеек, выравниванием по центру
// и заданным размером и типом шрифта
begin
with XLExp_Sheet.Range[XLExp_Col[Region.ColLeft]+IntToStr(Region.RowTop),
XLExp_Col[Region.ColRight]+IntToStr(Region.RowBottom)] do
begin
if Mrg then MergeCells := true;
Formula := Txt;
HorizontalAlignment := xlCenter;
VerticalAlignment := xlCenter;
Font.Size := FntSize;
Font.Bold := (efsBold in FntStyle);
Font.Italic := (efsItalic in FntStyle);
end;
end;
procedure XLExp_DrowBorder(Region: RXLExp_Region; Brd: CXLExp_BorderStyle);
// Процедура обводит указанный район листа рамкой заданного типа
begin
with XLExp_Sheet.Range[XLExp_Col[Region.ColLeft]+IntToStr(Region.RowTop),
XLExp_Col[Region.ColRight]+IntToStr(Region.RowBottom)].Borders do
begin
LineStyle := xlContinuous;
case Brd of
ebsThin: Weight := xlThin;
ebsMedium: Weight := xlMedium;
ebsThick: Weight := xlThick;
end;
end;
end;
function XLExp_SetDataInCell(Index1,Index2: OleVariant; Data: string): string;
// Записывает заданный текст в указанную ячейку
begin
XLExp_Report.ActiveWorkbook; // Активировать текущую книгу
// Лист книги, в котором править ячейку
XLExp_Sheet := XLExp_Workbook.Worksheets.Item[1] as Excel2000.ExcelWorkSheet;
// Присвоение ячейке заданного значения
XLExp_Sheet.Cells.Item[Index1,Index2].Value := Data;
end;
procedure XLExp_DataSetExport(Range: OleVariant; DataSet: TDataSet);
// Експорт данных из датасета в Excel-лист
// Область листа (Range) задается параметром Range
// Range задает область листа (непрерывная последовательность ячеек листа)
// начиная с которой будет итти заполнение из НД. При этом самой левой колонкой
// может любая колонка листа, а строкой - любая строка листа.
// Ячейки этой "линии" колонок должны содержать имена полей НД, данные которых
// будут помещаться в эти колонки
var
RangeLen,Column,Row,lich,i,x: integer;
ValueArray: OleVariant;
Str: string;
FieldArray: array [0..39] of string;
bm: TBookmark;
begin
// Строка начала района
Row:=XLExp_Sheet.Range[Range,EmptyParam].Row;
// Колонка начала района (левая крайняя)
Column:=XLExp_Sheet.Range[Range,EmptyParam].Column;
// Колонка конца района (правая крайняя)
RangeLen:=Column+(XLExp_Sheet.Range[Range,EmptyParam].Columns.Count-1);
// Переписать в массив FieldArray содержимое ячеек 1-й строки указанной области
// листа Excel (имена полей датасета).
// Предполагается, что их не должно быть более 21
x := 0;
for i := Column to RangeLen do
begin
Str := XLExp_Sheet.Cells.Item[Row,i].Formula; // Содержимое ячейки
Delete(Str,1,1); // Обрезаем первый (служебный) символ
FieldArray[x] := Str;
x := x+1;
end;
// Создать дин.массив размерностью RxC, где R - кол-во строк датасета,
// а C - кол-во колонок, заданное Range
ValueArray := VarArrayCreate([0,DataSet.RecordCount-1,0,XLExp_Sheet.Range[Range,EmptyParam].Columns.Count],varVariant);
lich := 0; // Индекс строки НД
// Подготовка датасета к сканированию
with DataSet do
begin
bm := GetBookmark; // Запомнить текущую запись
DisableControls;
First;
while not Eof do
begin
for i := 0 to XLExp_Sheet.Range[Range,EmptyParam].Columns.Count do
// Для каждой колонки Region определяется имя поля НД и значение
// этого поля записывается в дин.массив по адресу=индексу колонки
begin
if (FieldArray[i]<>'') then // Колонка имеет ссылку на имя поля ?
ValueArray[lich,i] := FieldByName(FieldArray[i]).AsString
else
ValueArray[lich,i] := '';
end;
lich := lich+1;
Next;
end;
EnableControls;
GotoBookmark(bm); // Вернуться в исходную (до сканирования) запись
FreeBookmark(bm);
end;
{ Выражение :
xlSheet.Range[Col[Column]+IntToStr(Row),Col[RangeLen]+IntToStr(Row+DataSet.RecordCount-1)]
представляет "экселовскую" адресацию типа "A10","H17", где буква - индекс колонки, а
число-индекс строки на листе Excel.
В нативном виде (в самом Excel`е) этот регион будет = "A10:H17"
}
// Перегнать в лист Excel (Ragion) значения из массива ValueArray
XLExp_Sheet.Range[XLExp_Col[Column]+IntToStr(Row),XLExp_Col[RangeLen]+IntToStr(Row+DataSet.RecordCount-1)].Value := ValueArray;
// Присвоить всем ячейкам региона Region цвет символов как у левой верхней ячейки
XLExp_Sheet.Range[XLExp_Col[Column]+IntToStr(Row),XLExp_Col[RangeLen]+IntToStr(Row+DataSet.RecordCount-1)].Font.Color := XLExp_Sheet.Range[Range,EmptyParam].Font.Color;
// Присвоить всем ячейкам региона Region цвет как у левой верхней ячейки
XLExp_Sheet.Range[XLExp_Col[Column]+IntToStr(Row),XLExp_Col[RangeLen]+IntToStr(Row+DataSet.RecordCount-1)].Interior.Color := XLExp_Sheet.Range[Range,EmptyParam].Interior.Color;
// Присвоить всем ячейкам региона Region рамки как у левой верхней ячейки
XLExp_Sheet.Range[XLExp_Col[Column]+IntToStr(Row),XLExp_Col[RangeLen]+IntToStr(Row+DataSet.RecordCount-1)].Borders.LineStyle := XLExp_Sheet.Range[Range,EmptyParam].Borders.LineStyle;
end;
function XLExp_ShowReport: boolean;
// Показать лист Excel`а для правки, сохранения и печати
begin
result := false;
if Assigned (XLExp_Report) then
begin
XLExp_Report.WindowState[0] := Excel2000.xlMaximized;
XLExp_Report.Visible[0] := true;
XLExp_Report.ScreenUpdating[0] := true;
result := true;
end;
end;
function XLExp_GetLastRow(Range: OleVariant; DataSet: TDataSet): integer;
// Возвращает индекс следующей за последней строкой (Row) листа,
// занятой (или которая будет занята после заливки данных из НД) данными.
// Начиная с этой строки можно располагать итоги или подвал документа
begin
XLExp_GetLastRow:=XLExp_Sheet.Range[Range,EmptyParam].Row+DataSet.RecordCount;
end;
end. |
(
Сообщение было отмечено как решение
