开博科技|手机开单|手机商店|送货单打印软件|销售管理系统|进销存|ERP供应链管理系统

标题: dbGridEh导出EXCEL时生成真正多表头 [打印本页]

作者: dianlanren    时间: 2017-4-24 13:34
标题: dbGridEh导出EXCEL时生成真正多表头
1、调用(通过点击按钮直接导出Excel):
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
procedure TForm3.Button1Click(Sender: TObject);
var
   GridtoExcel: TDBGridEhToExcel;
begin
   try
       GridtoExcel := TDBGridEhToExcel.Create(nil);
       GridtoExcel.DBGridEh := DBGridEh1;
       GridtoExcel.TitleName := '明细表';
       GridtoExcel.ShowProgress := true;
       GridtoExcel.ShowOpenExcel := true;
       GridtoExcel.ExportToExcel;
   finally
       GridtoExcel.Free;
   end;
end;

//-------------------------------
2,单元代码
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.







欢迎光临 开博科技|手机开单|手机商店|送货单打印软件|销售管理系统|进销存|ERP供应链管理系统 (http://kbhelp.757abc.com/) Powered by Discuz! X3.2