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
| unit Unit_DBGridEhToExcel;
//感谢原作者：蔡炆炆 2006年12月26日
//eW0ng(QQ:508882988)于2017年4月23日修正，能顺利运行在XE10.2 OFFICE2007成功导出多表头
interface
uses
SysUtils, Variants, Classes, Graphics, Controls, Forms, Excel2000, ComObj,
Dialogs, DB, DBGridEh, windows,ComCtrls,ExtCtrls;
type
TDBGridEhToExcel = class(TComponent)
private
FProgressForm: TForm; {进度窗体}
FtempGauge: TProgressBar; {进度条}
FShowProgress: Boolean; {是否显示进度窗体}
FShowOpenExcel:Boolean; {是否导出后打开Excel文件}
FDBGridEh: TDBGridEh;
FTitleName: TCaption; {Excel文件标题}
FUserName: TCaption; {制表人}
procedure SetShowProgress(const Value: Boolean); {是否显示进度条}
procedure SetShowOpenExcel(const Value: Boolean); {是否打开生成的Excel文件}
procedure SetDBGridEh(const Value: TDBGridEh);
procedure SetTitleName(const Value: TCaption); {标题名称}
procedure SetUserName(const Value: TCaption); {使用人名称}
procedure CreateProcessForm(AOwner: TComponent); {生成进度窗体}
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure ExportToExcel; {输出Excel文件}
published
property DBGridEh: TDBGridEh read FDBGridEh write SetDBGridEh;
property ShowProgress: Boolean read FShowProgress write SetShowProgress; //是否显示进度条
property ShowOpenExcel: Boolean read FShowOpenExcel write SetShowOpenExcel; //是否打开Excel
property TitleName: TCaption read FTitleName write SetTitleName;
property UserName: TCaption read FUserName write SetUserName;
end;
implementation
constructor TDBGridEhToExcel.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FShowProgress := True;
FShowOpenExcel:= True;
end;
procedure TDBGridEhToExcel.SetShowProgress(const Value: Boolean);
begin
FShowProgress := Value;
end;
procedure TDBGridEhToExcel.SetDBGridEh(const Value: TDBGridEh);
begin
FDBGridEh := Value;
end;
procedure TDBGridEhToExcel.SetTitleName(const Value: TCaption);
begin
FTitleName := Value;
end;
procedure TDBGridEhToExcel.SetUserName(const Value: TCaption);
begin
FUserName := Value;
end;
function IsFileInUse(fName: string ): boolean;
var
HFileRes: HFILE;
begin
Result :=false;
if not FileExists(fName) then exit;
HFileRes :=CreateFile(pchar(fName), GENERIC_READ
or GENERIC_WRITE,0, nil,OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL, 0);
Result :=(HFileRes=INVALID_HANDLE_VALUE);
if not Result then
CloseHandle(HFileRes);
end;
procedure TDBGridEhToExcel.ExportToExcel;
var
XLApp: Variant;
MyWorkBook: Variant;
Sheet: Variant;
s1, s2: string;
Caption,Msg: String;
Row, Col: integer;
iCount, jCount: Integer;
FBookMark: TBookmark;
FileName: String;
SaveDialog1: TSaveDialog;
begin
//如果数据集为空或没有打开则退出
if not DBGridEh.DataSource.DataSet.Active then Exit;
SaveDialog1 := TSaveDialog.Create(Nil);
SaveDialog1.FileName := TitleName + '_' + FormatDateTime('YYMMDDHHmmSS', now);
SaveDialog1.Filter := 'Excel文件|*.xls';
if SaveDialog1.Execute then
FileName := SaveDialog1.FileName;
SaveDialog1.Free;
if FileName = '' then Exit;
while IsFileInUse(FileName) do
begin
if Application.MessageBox('目标文件使用中，请退出目标文件后点击确定继续！',
'注意', MB_OKCANCEL + MB_ICONWARNING) = IDOK then
begin
end
else
begin
Exit;
end;
end;
if FileExists(FileName) then
begin
Msg := '已存在文件（' + FileName + '），是否覆盖？';
if Application.MessageBox(PChar(Msg), '提示', MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2) = IDYES then
begin
//删除文件
DeleteFile(PChar(FileName))
end
else
exit;
end;
Application.ProcessMessages;
Screen.Cursor := crHourGlass;
//显示进度窗体
if ShowProgress then
CreateProcessForm(nil);
if not VarIsEmpty(XLApp) then
begin
XLApp.DisplayAlerts := False;
XLApp.Quit;
VarClear(XLApp);
end;
//通过ole创建Excel对象
try
XLApp := CreateOleObject('Excel.Application');
except
MessageDlg('创建Excel对象失败，请检查你的系统是否正确安装了Excel软件！', mtError, [mbOk], 0);
Screen.Cursor := crDefault;
Exit;
end;
//生成工作页
//XLApp.WorkBooks.Add[XLWBatWorksheet];
MyWorkBook := CreateOleObject('Excel.Sheet');
MyWorkBook.WorkSheets[1].Name := TitleName;
Sheet := MyWorkBook.WorkSheets[1];
//写标题
sheet.cells[1, 1] := TitleName;
sheet.cells[1, 1].HorizontalAlignment:=3;//单元格居中
sheet.range[sheet.cells[1, 1], sheet.cells[1, DBGridEh.Columns.Count]].Select; //选择该列
//XLApp.selection.HorizontalAlignment := $FFFFEFF4; //居中
XLApp.selection.MergeCells := True; //合并
//写表头
Row := 1;
jCount := 3;
for iCount := 0 to DBGridEh.Columns.Count - 1 do
begin
Col := 2;
Row := iCount+1;
Caption := DBGridEh.Columns[iCount].Title.Caption;
while POS('|', Caption) > 0 do
begin
jCount := 4;
s1 := Copy(Caption, 1, Pos('|',Caption)-1);
if s2 = s1 then
begin
sheet.range[sheet.cells[Col, Row-1],sheet.cells[Col, Row]].Select;
//XLApp.selection.HorizontalAlignment := $FFFFEFF4;
XLApp.selection.MergeCells := True;
sheet.cells[Col, Row-1].HorizontalAlignment:=3;//单元格居中
end
else
Sheet.cells[Col,Row] := Copy(Caption, 1, Pos('|',Caption)-1);
Caption := Copy(Caption,Pos('|', Caption)+1, Length(Caption));
Inc(Col);
s2 := s1;
end;
Sheet.cells[Col, Row] := Caption;
Inc(Row);
end;
//合并表头并居中
if jCount = 4 then
for iCount := 1 to DBGridEh.Columns.Count do
if Sheet.cells[3, iCount].Value = '' then
begin
sheet.range[sheet.cells[2, iCount],sheet.cells[3, iCount]].Select;
//XLApp.selection.HorizontalAlignment := $FFFFEFF4;
XLApp.selection.MergeCells := True;
sheet.cells[2, iCount].HorizontalAlignment:=3;//单元格居中
end
else begin
sheet.cells[3, iCount].Select;
sheet.cells[3, iCount].HorizontalAlignment:=3;//单元格居中
//XLApp.selection.HorizontalAlignment := $FFFFEFF4;
end;
//读取数据
DBGridEh.DataSource.DataSet.DisableControls;
FBookMark := DBGridEh.DataSource.DataSet.GetBookmark;
DBGridEh.DataSource.DataSet.First;
while not DBGridEh.DataSource.DataSet.Eof do
begin
for iCount := 1 to DBGridEh.Columns.Count do
begin
//Sheet.cells[jCount, iCount] :=DBGridEh.Columns.Items[iCount-1].Field.AsString;
case DBGridEh.DataSource.DataSet.FieldByName(DBGridEh.Columns.Items[iCount-1].FieldName).DataType of
ftSmallint, ftInteger, ftWord, ftAutoInc, ftBytes:
Sheet.cells[jCount, iCount] :=DBGridEh.Columns.Items[iCount-1].Field.asinteger;
ftFloat, ftCurrency, ftBCD:
Sheet.cells[jCount, iCount] :=DBGridEh.Columns.Items[iCount-1].Field.AsFloat;
else
if DBGridEh.DataSource.DataSet.FieldByName(DBGridEh.Columns.Items[iCount-1].FieldName) is TBlobfield then // 此类型的字段(图像等)暂无法读取显示
Sheet.cells[jCount, iCount] :=DBGridEh.Columns.Items[iCount-1].Field.AsString
else
Sheet.cells[jCount, iCount] :=''''+DBGridEh.Columns.Items[iCount-1].Field.AsString;
end;
end;
Inc(jCount);
//显示进度条进度过程
if ShowProgress then
begin
FtempGauge.Position := DBGridEh.DataSource.DataSet.RecNo;
FtempGauge.Refresh;
end;
DBGridEh.DataSource.DataSet.Next;
end;
if DBGridEh.DataSource.DataSet.BookmarkValid(FBookMark) then
DBGridEh.DataSource.DataSet.GotoBookmark(FBookMark);
DBGridEh.DataSource.DataSet.EnableControls;
//读取表脚
if DBGridEh.FooterRowCount > 0 then
begin
for Row := 0 to DBGridEh.FooterRowCount-1 do
begin
for Col := 0 to DBGridEh.Columns.Count-1 do
Sheet.cells[jCount, Col+1] := DBGridEh.GetFooterValue(Row,DBGridEh.Columns[Col]);
Inc(jCount);
end;
end;
//调整列宽
// for iCount := 1 to DBGridEh.Columns.Count do
// Sheet.Columns[iCount].EntireColumn.AutoFit;
sheet.cells[1, 1].Select;
XlApp.Workbooks[1].SaveAs(FileName);
XlApp.Visible := True;
XlApp := Unassigned;
if ShowProgress then
FreeAndNil(FProgressForm);
Screen.Cursor := crDefault;
end;
destructor TDBGridEhToExcel.Destroy;
begin
inherited Destroy;
end;
procedure TDBGridEhToExcel.CreateProcessForm(AOwner: TComponent);
var
Panel: TPanel;
begin
if Assigned(FProgressForm) then
exit;
FProgressForm := TForm.Create(AOwner);
with FProgressForm do
begin
try
Font.Name := '宋体'; {设置字体}
Font.Size := 10;
BorderStyle := bsNone;
Width := 300;
Height := 30;
BorderWidth := 1;
Color := clBlack;
Position := poScreenCenter;
Panel := TPanel.Create(FProgressForm);
with Panel do
begin
Parent := FProgressForm;
Align := alClient;
Caption := '正在导出Excel，请稍候......';
Color:=$00E9E5E0;
end;
FtempGauge:=TProgressBar.Create(Panel);
with FtempGauge do
begin
Parent := Panel;
Align:=alClient;
Min := 0;
Max:= DBGridEh.DataSource.DataSet.RecordCount;
Position := 0;
end;
except
end;
end;
FProgressForm.Show;
FProgressForm.Update;
end;
procedure TDBGridEhToExcel.SetShowOpenExcel(const Value: Boolean);
begin
FShowOpenExcel:=Value;
end;
end.
|
|Archiver|手机版|小黑屋|开博维尔科技有限公司
( 粤ICP备13070897号 )
发表于 2017-4-24 13:34:14
收藏