dbgrideh导出到execl 多表头（转自NPC）

//*****************************************************************************
// NPC Add This 2019-05-15 16:29:54
// ----------------------------------------------------------------------------
// 名 称：TfrmPublic.ExpDBGridEh_Execl
// ----------------------------------------------------------------------------
// 用 途：导出Execl ,带多头 ， 最后后并列为特殊处理，
// ----------------------------------------------------------------------------
// 参 数：
// ZhiBR: 制表人
// ZhiBSJ: 制表时间
// MyTitle: 标题
// ShiJ1: 统计开始时间
// ShiJ2: 统计截止时间
// MyDBGridEh: 数据源
// TeSCL: 药房销售中草药报表专用 ， 其他功能可以参考
// ----------------------------------------------------------------------------
// 返回值：无
// ----------------------------------------------------------------------------
// 备 注： 引用单元 ComObj //TeSCL = True 药房销售中草药报表专用 ， 其他功能可以参考
//*****************************************************************************

procedure TfrmPublic.ExpDBGridEh_Execl(ZhiBR , ZhiBSJ , MyTitle , ShiJ1 , ShiJ2: string; MyDBGridEh: TDBGridEh ; TeSCL:Boolean = False);
var
ExpClass: TDBGridEhExportClass;
Ext: string;
HDataRow:integer;
eclApp,WorkBook:Variant; {声明为OLE Automation对象}
xlsFileName:String;
iCol , iRow:Integer;
MaxNumCol , i , z:Integer;
ColumnsTitleList:TStringList;
StartCol , EndCol:Integer;
FirstNR:String;
begin

SaveDialog1.FileName := MyTitle;
SaveDialog1.FilterIndex :=5;

if not SaveDialog1.Execute then
exit;

case SaveDialog1.FilterIndex of
1:
begin
ExpClass := TDBGridEhExportAsText;
Ext := 'txt';
end;
2:
begin
ExpClass := TDBGridEhExportAsCSV;
Ext := 'csv';
end;
3:
begin
ExpClass := TDBGridEhExportAsHTML;
Ext := 'htm';
end;
4:
begin
ExpClass := TDBGridEhExportAsRTF;
Ext := 'rtf';
end;
5:
begin
ExpClass := TDBGridEhExportAsXLS;
Ext := 'xls';
end;
else
ExpClass := nil;
Ext := '';
end;

if ExpClass = nil then
exit;

if UpperCase(Copy(SaveDialog1.FileName, Length(SaveDialog1.FileName) - 2, 3)) <> UpperCase(Ext) then
SaveDialog1.FileName := SaveDialog1.FileName + '.' + Ext;

try
ColumnsTitleList := TStringList.Create;
ColumnsTitleList.Delimiter := '|';

MyDBGridEh.DataSource.DataSet.DisableControls;
try
{创建OLE对象：Excel Application与WordBook}
eclApp := CreateOleObject('Excel.Application');
WorkBook:=CreateOleObject('Excel.Sheet');
Except
Application.MessageBox('你的机器没有安装Microsoft Excel', '使用Microsoft Excel',MB_OK+MB_ICONWarning);
Exit;
End;

HDataRow := 3 ;
xlsFileName:= SaveDialog1.FileName;

EclApp.Caption := '应用程序调用 Microsoft Excel1';

WorkBook:=eclApp.workbooks.Add;
EclApp.DisplayAlerts := False ; //不提示弹出对话框
EclApp.Cells(1,1):= MyTitle;

EclApp.Range[EclApp.Cells[1,1],EclApp.Cells[1,MyDBGridEh.FieldCount]].MergeCells:=True; //合并
EclApp.Range[EclApp.Cells[1,1],EclApp.Cells[1,MyDBGridEh.FieldCount]].HorizontalAlignment :=3; //水平居中
EclApp.Range[EclApp.Cells[1,1],EclApp.Cells[1,MyDBGridEh.FieldCount]].VerticalAlignment := 3; //垂直居中
EclApp.Range[EclApp.Cells[1,1],EclApp.Cells[1,MyDBGridEh.FieldCount]].font.size:=20; //设置单元格的字体大小
EclApp.Range[EclApp.Cells[1,1],EclApp.Cells[1,MyDBGridEh.FieldCount]].font.name:='宋体'; //字体格式
EclApp.Range[EclApp.Cells[1,1],EclApp.Cells[1,MyDBGridEh.FieldCount]].Borders.LineStyle := 1;//加边框

EclApp.Cells(2,1):= '统计时间:' + ShiJ1 + '至' + ShiJ2;

EclApp.Range[EclApp.Cells[2,1],EclApp.Cells[2,MyDBGridEh.FieldCount]].MergeCells:=True; //合并
EclApp.Range[EclApp.Cells[2,1],EclApp.Cells[2,MyDBGridEh.FieldCount]].font.size:=11; //设置单元格的字体大小
EclApp.Range[EclApp.Cells[2,1],EclApp.Cells[2,MyDBGridEh.FieldCount]].font.name:='宋体'; //字体格式
EclApp.Range[EclApp.Cells[2,1],EclApp.Cells[2,MyDBGridEh.FieldCount]].Borders.LineStyle := 1;//加边框

MaxNumCol := 1;
//格式化多层列头
//计算出最大的多层列数
for i := 0 to MyDBGridEh.FieldCount - 1 do
begin
ColumnsTitleList.Clear;
ColumnsTitleList.DelimitedText := MyDBGridEh.Columns[i].Title.Caption;
if ColumnsTitleList.Count> MaxNumCol then
MaxNumCol := ColumnsTitleList.Count;
end;

//生成电子表格多层列
for iCol := 0 to MyDBGridEh.FieldCount - 1 do
begin
ColumnsTitleList.Clear;
ColumnsTitleList.DelimitedText := MyDBGridEh.Columns[iCol].Title.Caption;
for i := 0 to MaxNumCol - 1 do
begin
if i <= ColumnsTitleList.Count - 1 then
EclApp.Cells(HDataRow + i, iCol + 1):= ColumnsTitleList[i]
else
EclApp.Cells(HDataRow + i, iCol + 1):= '';
EclApp.Cells[HDataRow + i, iCol + 1].font.size:=11; //设置单元格的字体大小
EclApp.Cells[HDataRow + i, iCol + 1].font.name:='宋体'; //字体格式
EclApp.Cells[HDataRow + i, iCol + 1].Borders.LineStyle := 1;//加边框
end;
end;

//合并列头
iCol := 0;
StartCol := -1;
EndCol := -1;
for iCol := 0 to MyDBGridEh.FieldCount - 1 do
begin
ColumnsTitleList.Clear;
ColumnsTitleList.DelimitedText := MyDBGridEh.Columns[iCol].Title.Caption;
//如果只有一层，对1至最大层进行合并
if ColumnsTitleList.Count = 1 then
EclApp.Range[EclApp.Cells[HDataRow , iCol + 1] , EclApp.Cells[HDataRow + MaxNumCol - 1 , iCol + 1]].MergeCells:=True;
end;

for i := 0 to MaxNumCol - 1 do
begin
iCol := 0;
while iCol <= MyDBGridEh.FieldCount - 1 do
begin
ColumnsTitleList.Clear;
ColumnsTitleList.DelimitedText := MyDBGridEh.Columns[iCol].Title.Caption;
if ColumnsTitleList.Count = 1 then
begin
Inc(iCol);
continue;
end;
if i <= (ColumnsTitleList.Count - 1 - i) then
begin
StartCol := iCol + 1;
FirstNR := ColumnsTitleList[i];
for z := StartCol to MyDBGridEh.FieldCount - 1 do
begin
ColumnsTitleList.Clear;
ColumnsTitleList.DelimitedText := MyDBGridEh.Columns[z].Title.Caption;
if i <= (ColumnsTitleList.Count - 1 - i) then
begin
if FirstNR <> ColumnsTitleList[i] then
begin
EndCol := z;
iCol := z;
Break;
end;
end;
end;
EclApp.Range[EclApp.Cells[HDataRow + i , StartCol] , EclApp.Cells[HDataRow + i , EndCol]].MergeCells:=True;
EclApp.Range[EclApp.Cells[HDataRow + i , StartCol] , EclApp.Cells[HDataRow + i , EndCol]].HorizontalAlignment :=3; //水平居中
Continue;
end;
Inc(iCol);
end;
end;

////////////////////////////////////////////////////////////////////////////////////////

//生成列头 不处理多层列头
// iCol := 0;
// for iCol := 0 to MyDBGridEh.FieldCount - 1 do
// begin
// EclApp.Cells(HDataRow , iCol + 1):= MyDBGridEh.Columns[iCol].Title.Caption;
// EclApp.Cells[HDataRow , iCol + 1].font.size:=11; //设置单元格的字体大小
// EclApp.Cells[HDataRow , iCol + 1].font.name:='宋体'; //字体格式
// EclApp.Cells[HDataRow , iCol + 1].Borders.LineStyle := 1;//加边框
// end;

HDataRow := HDataRow + MaxNumCol - 1;

iRow := 1;//生成行数据
MyDBGridEh.DataSource.DataSet.First;
While not MyDBGridEh.DataSource.DataSet.Eof do
begin

iCol := 0;
for iCol := 0 to MyDBGridEh.FieldCount - 1 do
begin
EclApp.Cells(iRow + HDataRow,iCol + 1):= MyDBGridEh.Columns[iCol].DisplayText ;//MyDBGridEh.Fields[iCol].Value;
EclApp.Cells[iRow + HDataRow,iCol + 1].font.size:=11; //设置单元格的字体大小
EclApp.Cells[iRow + HDataRow,iCol + 1].font.name:='宋体'; //字体格式
EclApp.Cells[iRow + HDataRow,iCol + 1].Borders.LineStyle := 1;//加边框
end;

inc(iRow);
MyDBGridEh.DataSource.DataSet.Next;
end;

 

EclApp.Cells(iRow + HDataRow,1):= '制表人：' + ZhiBR;//MyDBGridEh.Fields[iCol].Value;
EclApp.Range[EclApp.Cells[iRow + HDataRow,1],EclApp.Cells[iRow + HDataRow,MyDBGridEh.FieldCount]].MergeCells:=True; //合并
EclApp.Range[EclApp.Cells[iRow + HDataRow,1],EclApp.Cells[iRow + HDataRow,MyDBGridEh.FieldCount]].HorizontalAlignment := $FFFFEFC8; //xlcenter //水平居中
EclApp.Range[EclApp.Cells[iRow + HDataRow,1],EclApp.Cells[iRow + HDataRow,MyDBGridEh.FieldCount]].font.size:=11; //设置单元格的字体大小
EclApp.Range[EclApp.Cells[iRow + HDataRow,1],EclApp.Cells[iRow + HDataRow,MyDBGridEh.FieldCount]].font.name:='宋体'; //字体格式
EclApp.Range[EclApp.Cells[iRow + HDataRow,1],EclApp.Cells[iRow + HDataRow,MyDBGridEh.FieldCount]].Borders.LineStyle := 1;//加边框

inc(iRow);
EclApp.Cells(iRow + HDataRow,1):= '制表日期：' + ZhiBSJ ;//MyDBGridEh.Fields[iCol].Value;
EclApp.Range[EclApp.Cells[iRow + HDataRow,1],EclApp.Cells[iRow + HDataRow,MyDBGridEh.FieldCount]].MergeCells:=True; //合并
EclApp.Range[EclApp.Cells[iRow + HDataRow,1],EclApp.Cells[iRow + HDataRow,MyDBGridEh.FieldCount]].HorizontalAlignment := $FFFFEFC8; //xlcenter //水平居中
EclApp.Range[EclApp.Cells[iRow + HDataRow,1],EclApp.Cells[iRow + HDataRow,MyDBGridEh.FieldCount]].font.size:=11; //设置单元格的字体大小
EclApp.Range[EclApp.Cells[iRow + HDataRow,1],EclApp.Cells[iRow + HDataRow,MyDBGridEh.FieldCount]].font.name:='宋体'; //字体格式
EclApp.Range[EclApp.Cells[iRow + HDataRow,1],EclApp.Cells[iRow + HDataRow,MyDBGridEh.FieldCount]].Borders.LineStyle := 1;//加边框

//药房销售中草药报表专用 ， 其他功能可以参考
if TeSCL then
begin
//处理合并功能
i := 0;
iRow := 1;//生成行数据
MyDBGridEh.DataSource.DataSet.First;
i := MyDBGridEh.DataSource.DataSet.FieldByName('XH').AsInteger;
StartCol := iRow + HDataRow;
iCol := MyDBGridEh.FieldCount;

While not MyDBGridEh.DataSource.DataSet.Eof do
begin
if i <> MyDBGridEh.DataSource.DataSet.FieldByName('XH').AsInteger then
begin
EndCol := iRow + HDataRow - 1;
EclApp.Range[EclApp.Cells[StartCol , iCol] , EclApp.Cells[EndCol , iCol]].MergeCells:=True;
StartCol := iRow + HDataRow;
i := MyDBGridEh.DataSource.DataSet.FieldByName('XH').AsInteger;
end;
inc(iRow);
MyDBGridEh.DataSource.DataSet.Next;
end;

EndCol := iRow + HDataRow - 1;
EclApp.Range[EclApp.Cells[StartCol , iCol] , EclApp.Cells[EndCol , iCol]].MergeCells:=True;
end;
//EclApp.Rows.EntireColumn.AutoFit;//excel自动调整列

try
//保存文件
WorkBook.SaveAS(xlsFileName);
MSGMessage('保存完成！');
except
on e:exception do
begin
Showmessage(e.Message);
end;
end;
finally
FreeAndNil(ColumnsTitleList);
MyDBGridEh.DataSource.DataSet.EnableControls;
WorkBook.close;
EclApp.Quit;
{释放Variant变量}
WorkBook := Unassigned;
eclApp:=Unassigned;
end;

end;